比较两个记录集变量给出类型不匹配

Posted 2023-05-08

【中文标题】比较两个记录集变量给出类型不匹配

【英文标题】：Compare two recordset variables gives type mismatch

【发布时间】：2013-11-23 12:07:18

【问题描述】：

我有一个包含多个子表单的绑定表单。其中一些子表单可以有 0 条或更多条记录，而另一些则有 1 条或更多条记录。 该表单始终以只读方式打开，并且上面有一个“编辑”和一个“关闭”按钮。 当用户单击编辑按钮时，我将当前记录的内容与子表单的所有记录一起保存，以便当他/她单击关闭按钮时，我可以询问是否保存，如果没有，则丢弃更改从保存的记录中恢复。 到目前为止，这是编辑按钮的代码（其中GclnAllCnts 是字典类型的全局变量）：

Private Sub EditLibroBtn_Click()
    On Error GoTo Err_EditLibroBtn_Click
    Dim lngID         As Long
    Dim ctlCnt        As Control
    Dim rs            As Recordset
    lngID = Me.ID
    Set GclnAllCnts = New Dictionary
    GclnAllCnts.Add Me.Name, Me.RecordsetClone
    For Each ctlCnt In Me.Controls
        If (ctlCnt.ControlType = acSubform) Then
            Set rs = ctlCnt.Form.RecordsetClone
            If rs.RecordCount > 0 Then
                GclnAllCnts.Add ctlCnt.Name, ctlCnt.Form.RecordsetClone
            Else
                GclnAllCnts.Add ctlCnt.Name, Null
            End If
        End If
    Next
    DoCmd.Close acForm, Me.Name
    DoCmd.OpenForm GCstMainFrmName, , , "ID = " & lngID, acFormEdit, acDialog

Exit_EditLibroBtn_Click:
    Set ctlCnt = Nothing
    Set rs = Nothing
    Exit Sub

Err_EditLibroBtn_Click:
    MsgBox err.Description & vbNewLine & "Error number: " & err.Number, vbCritical, "Errore"
    Resume Exit_EditLibroBtn_Click
End Sub

这是关闭按钮的代码：

Private Sub ChiudiBtn_Click()
    On Error GoTo Err_ChiudiBtn_Click
    Dim intBoxAwr   As Integer
    Dim stSQL       As String
    Dim vKey        As Variant
    Dim ctlCnt      As Control
    Dim clnAllCnts  As Dictionary
    Dim bSaveNeeded As Boolean
    bSaveNeeded = False
    If (Me.AllowEdits And Me.ID <> "" And Not IsNull(Me.ID)) Then
        Set clnAllCnts = New Dictionary
        clnAllCnts.Add Me.Name, Me.RecordsetClone
        For Each ctlCnt In Me.Controls
            If (ctlCnt.ControlType = acSubform) Then
                Set rs = ctlCnt.Form.RecordsetClone
                If rs.RecordCount > 0 Then
                    clnAllCnts.Add ctlCnt.Name, ctlCnt.Form.RecordsetClone
                Else
                    clnAllCnts.Add ctlCnt.Name, Null
                End If
            End If
        Next
       If clnAllCnts.Count <> GclnAllCnts.Count Then
            bSaveNeeded = True
        Else
            For Each vKey In clnAllCnts.keys()
                If Not GclnAllCnts.Exists(vKey) Then
                    bSaveNeeded = True
                    Exit For
                Else
'*********** Next Gives error **********
                    If clnAllCnts.Item(vKey) <> GclnAllCnts.Item(vKey) Then
                        bSaveNeeded = True
                        Exit For
                    End If
                End If
            Next
        End If
        If bSaveNeeded Then
            intBoxAwr = MsgBox("Salvare le modifiche al libro?", vbYesNo + vbQuestion, "Salvare")
            If intBoxAwr = vbYes Then
        'etc., omitting code
End Sub

我得到的错误是 Type mismatch (nr. 13)，它由 <> 比较给出（我可以 Debug.print IsNull(clnAllCnts.Item(vKey)) 和 IsNull(GclnAllCnts.Item(vKey))。如何比较两个记录集变量？

【参考方案1】：

通过简单地说If rst1 <> rst2 来比较两个Recordset 对象无论如何都可能是冒险的，因为这到底意味着什么？如果rst1 和rst2 真的 是不同的对象（即使它们属于相同的对象类型），这样的表达式每次都可以很好地返回True。

您似乎对两个 Recordset 的 内容 是否相同感兴趣。在这种情况下，我倾向于序列化记录集数据并存储生成的String，而不是存储Recordset 对象本身。

在这种情况下，以下 VBA 函数可能会有所帮助。它遍历记录集对象并生成包含当前记录集数据的类似 JSON 的字符串。

（请注意，该函数不一定会生成有效的 JSON。它不会转义非打印字符，如 vbCr 和 vbLf。它不会转义反斜杠 (\)。它将所有值存储为“字符串”或null。换句话说，在其当前形式下，它并非旨在生成稍后可以反序列化的字符串。）

Private Function rstSerialize(ByVal rst As DAO.Recordset)
    ' loop through the recordset and generate a JSON-like string
    '     NB: This code will NOT necessarily produce valid JSON!
    '
    Dim s As String, fld As DAO.Field, rowCount As Long, fldCount As Long

    s = ""
    If Not (rst.BOF And rst.EOF) Then
        rst.MoveFirst
        rowCount = 0
        Do Until rst.EOF
            If rowCount > 0 Then
                s = s & ", "
            End If
            s = s & """row"": "
            fldCount = 0
            For Each fld In rst.Fields
                If fldCount > 0 Then
                    s = s & ", "
                End If
                s = s & """" & fld.Name & """: " & IIf(IsNull(fld.Value), "null", """" & fld.Value & """")
                fldCount = fldCount + 1
            Next
            s = s & ""
            rowCount = rowCount + 1
            rst.MoveNext
        Loop
    End If
    s = s & ""
    rstSerialize = s
End Function

数据示例：如果记录集包含

DonorID  Amount
-------  ------
      1      10
      2      20

函数会返回字符串

"row": "DonorID": "1", "Amount": "10", "row": "DonorID": "2", "Amount": "20"

用法示例：在包含子表单的表单上，主表单上的按钮可以执行以下操作

Private Sub Command3_Click()
    Dim rst As DAO.Recordset, originalState As String
    Set rst = Me.MemberDonationsSubform.Form.RecordsetClone
    originalState = rstSerialize(rst)
    rst.MoveFirst
    rst.Edit
    rst!Amount = rst!Amount + 1
    rst.Update
    Debug.Print "(Recordset updated.)"
    If rstSerialize(rst) = originalState Then
        Debug.Print "Recordset does not appear to have changed."
    Else
        Debug.Print "Recordset appears to have changed."
    End If
End Sub

这将在 VBA 即时窗口中打印以下内容

(Recordset updated.)
Recordset appears to have changed.