Question

我正在生成供应商表单，我将在其中添加Supplier_Name，Supplier_Code会自动生成Supplier_Name的前两个字符并为其添加唯一编号2个供应商具有相同的前2个字符，例如：

SundriesSupplier 1 = SU01;
SugarSupplier 1 = SU02

我是VBA的新手，并尝试了以下但不起作用：

Private Sub Supplier_Name_AfterUpdate()
    Dim DB As Database
    Dim RS As Recordset
    Dim SQL As String
    Dim var1 As String

    var1 = Left(Me.Supplier_Name.Value, 2)

    SQL = "SELECT Supplier_ID, LEFT(Supplier_Name,2) AS charsupplier, count (Supplier_Name) AS countSupplier " _
        & "FROM Suppliers " _
        & "WHERE charsupplier = var1 " _
        & "ORDER BY Supplier_ID"

     Set DB = CurrentDb
     Set RS = DB.OpenRecordset(SQL, dbOpenDynaset)

    Me.Supplier_Code = var1 & Format$(RS!countSupplier, "00")

    End Sub

如果有人可以帮助或建议一种非常感谢的替代方法。

编辑：我认为我的方法中的缺陷可能是，如果这是在新记录上，那么supplier_ID不会保存到表中，也不会用于查询？

Answer 1

根据名为cmdAddNewSupplier的按钮，您可以开始使用此功能。您应该有足够的能力使示例适应您的需求。 （对不起，我编辑了因为我忘了提到示例代码使用的是名为[SUPPLIERS]的虚构表，其虚拟列名为[SUPPLIER_NAME];您需要替换为表和列的名称。）

Private Sub cmdAddNewSupplier_Click()
  'TODO: create some error handling
  'TODO: check for null value of SupplierName Textbox; notify user and exit if its null
  'TODO: check for less than 2 chars for supplier name; notify user and exit if it's less than 2 chars (seems impossible, but can happen)
  Dim strSupCode As String 'the eventual unique id of the new supplier

  'make sure the user wants to add the supplier if the name already exists
  'all we are doing is utilizing DLookup so we don't have to deal with recordset object
  If Not IsNull(DLookup("[SUPPLIER_NAME]", "[SUPPLIERS]", "[SUPPLIER_NAME] = " & Chr(34) & Me.Supplier_Name & Chr(34))) Then
    If MsgBox(Me.Supplier_Name & " Already Exists!" & vbCrLf & "Are you sure that you want to add them?", vbYesNoCancel Or vbQuestion, "Please Confirm") <> vbYes Then
      Exit Sub
    End If
  End If

  strSupCode = GetSupplierCode(Me.Supplier_Name)

  MsgBox Me.Supplier_Name & vbCrLf & strSupCode 'test it out to make sure it's working before doing anything for real
End Sub

Function GetSupplierCode(strSupplierName As String) As String
  Dim nLoop As Long
  Dim strCode As String

  strCode = UCase(Left(strSupplierName, 2))

  'The supplier name is unique or the user means to add another supplier with the same name
  For nLoop = 1 To 100 '100 same names is unlikely, eh?

    'create a temp supplier code starting with 1 and increment
    'the return value is being set, so all we have to do is jump out of function when unique is found
    GetSupplierCode = strCode & Format(nLoop, "00")

    'TODO: utilize DLookup to check for existence; will leave this part to you;
    'dont forget you are looking at CODE and not NAME here as we did in the button click function

    '      if isnull(DLookup(<enter the required parameters>)) then
    '         exit function 'jump out of the function because this one should be the next unique
    '      end if

  Next

End Function

Answer 2

我已经设法使用以下代码解决了我的问题：

 Private Sub Supplier_Name_LostFocus()

If IsNull([Supplier_Code]) Then
   Dim DB As Database
   Dim RS As Recordset
   Dim var2 As String
   Dim var1 As String
   Dim var3 As String


   var1 = Left(Me.Supplier_Name, 2)

   var2 = "SELECT count(*) AS CountSupplier " & _
          "FROM Suppliers " & _
          "WHERE left(Suppliers.[Supplier_Name],2)='" & var1 & "';"
'   MsgBox (var2)



   Set DB = CurrentDb
   Set RS = DB.OpenRecordset(var2, dbOpenDynaset)
   var3 = RS!CountSupplier + 1
   Me.Supplier_Code = UCase(var1) & Format(var3, "00")
End If
End Sub

在Access VBA中使用唯一编号从另一个字段值创建连锁代码

2 个答案: