通过 SQL 存储过程记录集访问 VBA 循环进入子表单

Access VBA loop through SQL stored procedure recordset into subform

我正在为 SQL 数据库开发一个解决方案,其中包含用于数据输入的 Access 表单。在这个应用程序中,我有客户,并且正在努力提供一个子表单来显示任何可能的重复项。

在另一个 post 中,我找到了一个存储过程的解决方案,它将识别 3 种类型的重复项(确切地说,在 3 列之间具有“差异”因子的那些,以及具有相同名称的那些,其中一个地址为空,一个不为空)。此存储过程还会在 3 种类型中的每一种中查找一个重复项,作为我正在评估的当前客户的 ID。

解决方案在这里:

现在,在 Access 端,我在客户的主窗体上创建了一个私有函数,其中我 运行 存储过程,传递 ID 参数,然后寻求仅显示子窗体和子窗体 tab/page如果有结果。所有这一切似乎都有效,但是当我循环遍历存储过程的记录集输出时,我需要将其映射到子表单的未绑定字段。它对重复项中的 1 个执行此操作,但不是对所有结果执行此操作。

我正在测试一个有 3 个重复项的记录(包括它自己的返回记录)。我在连续子表单上只得到 1 条记录,如果不是 3,我应该得到 2,如果它包含它自己的记录。

我 运行 此功能作为我在表单上导航的一部分,当用户转到下一条记录、上一条记录时,使用组合键跳转到一条记录,或调出一个表单来搜索一条记录,然后转到该记录。

Private Function FindDuplicates()
    Dim cmd As New ADODB.Command
    Dim conn As ADODB.Connection
    Dim prm As ADODB.Parameter
    Dim strConn As String
    Dim strSQL As String
    Dim rs As ADODB.Recordset
    Dim dRecs As Integer

    strConn = "Provider=sqloledb;Server=MySQLServerName;Database=MyDBName;Trusted_Connection=yes;"

    Set conn = New ADODB.Connection
    conn.Open strConn

    Set cmd = New ADODB.Command
    cmd.CommandText = "sp_FindMyDuplicates"
    cmd.CommandType = adCmdStoredProc
    cmd.ActiveConnection = conn

    Set prm = cmd.CreateParameter("CID", adInteger, adParamInput)
    cmd.Parameters.Append prm
    cmd.Parameters("CID").Value = Me.ID

    'Execute the stored procedure
    Set rs = cmd.Execute
    dRecs = -1
    With rs

'        Debug.Print .RecordCount & " is record count"
    
        If (rs.EOF = True) And (rs.BOF = True) Then
            Me.pgDuplicates.Visible = False
        Else
            Me.pgDuplicates.Visible = True
    
            If Not .BOF And Not .EOF Then
                
                While (Not .EOF)
                    dRecs = dRecs + 1
                    'Debug.Print "customer ID: " & rs.Fields("ID") & " customer name: " & rs.Fields("FirstName")
                    Me.frmCustomers_subDuplicates.Form.txtFirst = rs.Fields("FirstName")
                    Me.frmCustomers_subDuplicates.Form.txtLast = rs.Fields("LastName")
                    Me.frmCustomers_subDuplicates.Form.txtAddress1 = rs.Fields("Add1")
                    Me.frmCustomers_subDuplicates.Form.txtAddress2 = rs.Fields("Add2")
                    Me.frmCustomers_subDuplicates.Form.txtCity = rs.Fields("City")
                    Me.frmCustomers_subDuplicates.Form.txtState = rs.Fields("State")
                    Me.frmCustomers_subDuplicates.Form.txtZip = rs.Fields("Zip")
                .MoveNext
                Wend
                Me.frmCustomers_subDuplicates.Form.txtDuplicateCount = dRecs & " Duplicates Found"
            End If
        End If
    
        .Close
    End With
    'Close the connection
    conn.Close
    
End Function

有人明白为什么我没有获取记录集中的所有记录吗?

您正在用 -1 而不是 0 初始化 dRecs。所以会少显示一个

您似乎一直在将值分配给相同的文本框,而没有在子表单中添加新行。

插入行

Me.frmCustomers_subDuplicates.SetFocus

在循环之前插入行

DoCmd.GoToRecord , , acNewRec

dRecs = dRecs + 1 行之后始终在子表单中插入新记录。

我最终解决了这个问题。感谢大家的宝贵意见和建议。

Private Function FindDuplicates()
Dim cmd As New ADODB.Command
Dim conn As ADODB.Connection
Dim prm As ADODB.Parameter
Dim strConn As String
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim dRecs As Integer

If Not Me.NewRecord Then

    strConn = "Provider=sqloledb;Server=ServerName;Database=DatabaseName;Trusted_Connection=yes;"

    Set conn = New ADODB.Connection
    conn.Open strConn

    Set cmd = New ADODB.Command
    cmd.CommandText = "sp_FindMyDuplicates"
    cmd.CommandType = adCmdStoredProc
    cmd.ActiveConnection = conn

    Set prm = cmd.CreateParameter("CID", adInteger, adParamInput)
    cmd.Parameters.Append prm
    cmd.Parameters("CID").Value = Me.ID

    'Execute the Stored Procedure
    cmd.Execute
    If DCount("ID", "tblCustomerDupesTemp", "ID = " & Me.ID) = 0 Then
        Me.pgDuplicates.Visible = False
    Else
        Me.pgDuplicates.Visible = True
        Me.frmCustomer_subDuplicates.Form.Filter = "[ID] <> " & Me.ID & " And [AnchorID] = " & Me.ID
        Me.frmCustomer_subDuplicates.Form.FilterOn = True
        Me.frmCustomer_subDuplicates.Form.txtDuplicateCount = CStr(Me.frmCustomer_subDuplicates.Form.CurrentRecord) & " of " & _
        DCount("ID", "tblCustomerDupesTemp", "ID <> " & Me.ID) & " Duplicate Customer(s)"
        Me.frmCustomer_subDuplicates.Form.Requery
    End If
End If
End Function