如何使用 DataMacros 运行 VBA 以记录记录更改答案

【问题标题】：How to use DataMacros to run VBA to log record changes如何使用 DataMacros 运行 VBA 以记录记录更改
【发布时间】：2020-03-04 02:15:39
【问题描述】：

我有一个包含多个表的 MS Access 数据库，每个表都有不同的字段（每个表都有一个主键）。每当有人更改现有记录时，我希望将之前/之后的状态记录到“历史”表中，但我试图避免为每个表创建 20 多个字段的 DataMacro，因为这看起来很麻烦且难以管理。

为了实现这一点，我添加了“更改前”和“更新后”宏，每个宏都有一个 SetLocalVar 调用来运行驻留在本地模块中的公共 vba 函数。 "before" 函数循环遍历当前表中存在的任何字段以构建更改前值的字典。 “after”函数重复该过程以识别更改的字段，以便可以将信息添加到历史表中（包含表名、字段名、前/后值、用户、时间戳等）。

我遇到的问题是“更新后”功能仅显示更改前的数据。我不知道新值是什么或更改了哪个字段。我无法将 [Old].[FieldName],[FieldName] 作为 SetLocalVar 的输入，因为我事先不知道哪些字段将被更新（并且表之间的字段名称不同）。而且我无法调用 Requery 或 Refresh，因为它与“更新后”过程发生冲突。

在我在这里和其他地方可以找到的所有类似问题中，他们要么从明确知道哪个字段将更改开始，要么在日志事件中不提供该级别的详细信息。或者我的 google-fu 很弱。

这是我所拥有的：

SetLocalVar 表达式之前（每个表的输入表名不同）：

=SetupLogEvent("Table01",[KeyName])

SetLocalVar表达式后：

=SubmitLogEvent("Table01",[KeyName])

模块代码

Public BeforeFields As Scripting.Dictionary

Public Function SetupLogEvent(ByVal TableName As String, ByVal KeyName As String)
    Set BeforeFields = New Scripting.Dictionary
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM [" & TableName & "] WHERE KeyName='" & KeyName & "'")
    Dim i As Long
    With rs
        .MoveLast
        .MoveFirst
        For i = 0 To rs.Fields.Count - 1
            fName = rs.Fields(i).Name
            fVal = rs.Fields(i).Value
            BeforeFields.Add fName, fVal
        Next i
    End With
    rs.Close
    SetupLogEvent = True
End Function

Public Function SubmitLogEvent(ByVal TableName As String, ByVal KeyName As String)
    DoEvents
    Dim MakeUpdate As Boolean
    MakeUpdate = False
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM [" & TableName & "] WHERE KeyName='" & KeyName & "'")
    With rs
        .MoveLast
        .MoveFirst
        For i = 0 To rs.Fields.Count - 1
            fName = rs.Fields(i).Name
            fVal = rs.Fields(i).Value
            If fVal <> BeforeFields(fName) Then
                Debug.Print ("Modified field is " & fName)
                MakeUpdate = True
                Exit For
            End If
        Next i
    End With
    rs.Close
    If MakeUpdate = True Then
        'Run SQL code to update the history table with the relevant information
        'DoCmd.RunSQL <SQL code here>
    End If
    Set BeforeFields = Nothing
    SubmitLogEvent = True
End Function

我怀疑我应该使用其他方法而不是循环浏览记录集，但我不确定我应该做什么。我想我可以在 after 函数中添加几十个可选输入，并手动将每个表的每个 [FieldName] 输入到每个表的 SetLocalVar 表达式中，但我无法想象系统如此不灵活以至于需要这样做。一定有更好的方法吧？

编辑：我已经更新了这个问题的标题以及我避免为每个字段编写 DataMacro 以供该主题的未来读者阅读的原因。

【问题讨论】：

点评allenbrowne.com/AppAudit.html
搜索DataMacro，也许这可以帮助你scottgem.wordpress.com/2012/10/18/…
您可以从 After Update 宏中访问旧值，因此您可能会通过同时使用宏之前和之后使事情变得比需要的更难，并且可能会产生一些奇怪的时序问题，可能解释你正在经历的行为。尝试只使用After Update进行现场比较。

标签： vba ms-access

【解决方案1】：

感谢 braX、krish KM 和 SunKnight 为您提供上述 cmets。

我已经开发了一个适合我自己需求的流程，但我将简要解释一下我的推理：

其他方法的限制：

Allenbrowne 的解决方案（1）要求用户使用表单和（2）要求键是自动编号（我的必须是字符串文本）
Scottgem 的解决方案排除了表单的使用。我向我的用户提供了一个表单来快速更新他们经常交互的字段，但是有些表有 20 多个字段，我给他们的任何表单（12 多个表和 20 多个半唯一字段）都比让他们更复杂它们与表格本身进行交互（虽然通常不赞成，但在这种情况下，表格暴露恰好不是问题，只要我们进行一些跟踪）。
手动生成的 DataMacros 不灵活 - 我无法将它们的任何部分复制粘贴到新表中以快速更新我感兴趣的字段（添加、删除、更改等）。这个数据库是新的，所以我希望随着时间的推移添加新字段，优先级和重点会发生变化。

解决方案：

在我发布的问题结束时，我提到我可以将更新后的值输入到具有可选输入的函数中，并让函数在内部进行前后比较，这就是我所做的。

限制：

如果您不处理表达式中的空值，DataMacros 会抛出错误
DataMacros 有 255 个字符的限制

由于上面的#1，我不得不将输入包装在 Nz() 函数中。我的方案还涉及以键/值格式向“后”函数提供输入，这需要详细声明。由于 255 个字符的限制，我决定一次只跟踪每个表的 6-10 个字段（为了做更多的事情，我只是在第二个 DataMacro 中重复这个过程）。

Public TableChangedName As String
Public TableChangedKey As String
Public SuppressLog As Boolean

Public Function SetupLogEvent(ByVal TableName As String, ByVal KeyName As String)
    'This function reads the recordset as-is to build a 'before' dictionary

    'SuppressLog is True when updating via user form
    'The form will make its own submissions to the history log to specify which form did the update
    If SuppressLog = False Then
        Set BeforeFields = New Scripting.Dictionary
        Set rs = CurrentDb.OpenRecordset("SELECT * FROM [" & TableName & "] WHERE KeyName='" & KeyName & "'")
        Dim i As Long
        Do While Not rs.EOF
            rs.MoveLast
            rs.MoveFirst
            For i = 0 To rs.Fields.Count - 1
                fName = rs.Fields(i).Name
                fVal = rs.Fields(i).Value
                BeforeFields.Add fName, CStr(Nz(fVal, ""))
            Next i
            rs.MoveNext
        Loop
        rs.Close
        TableChangedName = TableName
        TableChangedKey = KeyName
        SetupLogEvent = True
    End If
End Function

Public Function SubmitLogEvent(Optional ByVal Input1 As String = "None", Optional ByVal Input2 As String = "None", Optional ByVal Input3 As String = "None", Optional ByVal Input4 As String = "None", Optional ByVal Input5 As String = "None", Optional ByVal Input6 As String = "None", Optional ByVal Input7 As String = "None", Optional ByVal Input8 As String = "None", Optional ByVal Input9 As String = "None", Optional ByVal Input10 As String = "None", Optional ByVal Input11 As String = "None", Optional ByVal Input12 As String = "None")
    'This function submits an entry to the _History table for each field that was changed, marking the change as "Manually updated" (i.e. no form used)

    'SuppressLog is True when updating via user form
    'The form will make its own submissions to the history log to specify which form did the update
    If SuppressLog = False Then
        Dim InputArray As Variant
        InputArray = Array(Input1, Input2, Input3, Input4, Input5, Input6, Input7, Input8, Input9, Input10, Input11, Input12)
        Set AfterFields = New Scripting.Dictionary
        For i = LBound(InputArray) To UBound(InputArray) Step 2
            If InputArray(i) = "None" Then
                'End of used input fields
                Exit For
            Else
                AfterFields.Add InputArray(i), InputArray(i + 1)
            End If
        Next i
        DoCmd.SetWarnings False
        For Each fName In AfterFields.Keys
            If BeforeFields(fName) <> AfterFields(fName) Then
                strSQL = "INSERT INTO _History ([TableModified],[KeyName],[Field],[From],[To],[User],[TimeStamp],[Method]) VALUES ('" & TableChangedName & "','" & TableChangedKey & "','" & fName & "','" & BeforeFields(fName) & "','" & AfterFields(fName) & "','" & Environ("username") & "','" & Now() & "','Manually updated')"
                Debug.Print ("strSQL = """ & strSQL & """")
                DoCmd.RunSQL strSQL
            End If
        Next fName
        DoCmd.SetWarnings True
    End If
    SubmitLogEvent = True
End Function

使用上面的这两个函数，我唯一需要更新每个表的就是表达式。

SetLocalVar 表达式之前：

=SetupLogEvent("Table01",[KeyName])

SetLocalVar表达式后：

=SubmitLogEvent('Field1',Nz([Field1]),'Field2',Nz([Field2]),'Field3',Nz([Field3]),'Field4',Nz([Field4]))

如果一个新字段被添加到需要跟踪的一个或多个表中，我会更新 FieldList 变量并重新运行以下函数：

Private Function PrintExpression()
    'Enter the list of fields you want to track, separated by commas
    FieldList = "Field_1,Field_2,Field_3,Field_4,Field_5"

    exprString = "=SubmitLogEvent("
    For Each Entry In Split(FieldList, ",")
        exprString = exprString & "'" & Entry & "',Nz([" & Entry & "]),"
    Next
    exprString = RxReplace(exprString, ",$", ")")
    If Len(exprString) > 255 Then
        Call MsgBox("This result is > 255 characters (" & Len(exprString) & ") and will be rejected.", vbExclamation + vbOKOnly, "Input Too Long")
    Else
        Debug.Print ("=SetupLogEvent(""<<< Table Name >>>"",[KeyName])")
        Debug.Print (exprString)
    End If
End Function

输出：

=SetupLogEvent(">>",[KeyName])

=SubmitLogEvent('Field_1',Nz([Field_1]),'Field_2',Nz([Field_2]),'Field_3',Nz([Field_3]),'Field_4',Nz([Field_4]), 'Field_5',Nz([Field_5]))

我将第二个表达式复制/粘贴到任何使用这些字段的表中，我就完成了。如果我需要跟踪每个表超过 6-10 个字段，我使用第二个 FieldList 重新运行上面的函数，并将其添加到表的第二个 DataMacro 下。冲洗并根据需要重复。

【讨论】：