如何使用DataMacros运行VBA来记录更改

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

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

我遇到的问题是，“更新后”函数只显示更改前的数据。我不知道新值是什么，也不知道更改了哪个字段。我无法将[Old]。[FieldName]，[FieldName]作为输入输入输入到SetLocalVar，因为我事先不知道哪些字段将被更新（表之间的字段名不同）。我不能调用重新查询或刷新，因为它与“更新后”过程冲突

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

以下是我所拥有的：

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

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

Public BeforeFields作为脚本.Dictionary
公共函数SetupLogEvent（ByVal TableName作为字符串，ByVal KeyName作为字符串）
Set BeforeFields=New Scripting.Dictionary
Set rs=CurrentDb.OpenRecordset（“从[”&TableName&“]中选择*，其中KeyName=”&KeyName&“”）
我想我会坚持多久
用rs
.最后一个
.先走一步
对于i=0到rs.Fields.Count-1
fName=rs.Fields（i）.Name
fVal=rs.字段（i）.值
BeforeFields.addfname，fVal
接下来我
以
rs.Close
SetupLogEvent=True
端函数
公共函数SubmitLogEvent（ByVal TableName作为字符串，ByVal KeyName作为字符串）
多芬特
将MakeUpdate设置为布尔值
MakeUpdate=False
Set rs=CurrentDb.OpenRecordset（“从[”&TableName&“]中选择*，其中KeyName=”&KeyName&“”）
用rs
.最后一个
.先走一步
对于i=0到rs.Fields.Count-1
fName=rs.Fields（i）.Name
fVal=rs.字段（i）.值
如果fVal BeforeFields（fName），则
打印（“修改的字段为”&fName）
MakeUpdate=True
退出
如果结束
接下来我
以
rs.Close
如果MakeUpdate=True，则
'运行SQL代码以使用相关信息更新历史记录表
'DoCmd.RunSQL
如果结束
Set BeforeFields=Nothing
SubmitLogEvent=True
端函数

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

---

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

感谢braX、krish KM和SunKnight的上述评论

我已经开发了一个适合我自己需要的流程，但我将简要说明我的理由：

其他方法的局限性：

的解决方案（1）要求用户使用表单，（2）要求密钥为自动编号（我的密钥必须为字符串文本）

的解决方案排除了表单的使用。我为我的用户提供了一个表单来快速更新他们通常交互的字段，但是有些表有20多个字段，我给他们的任何表单（12多个表和20多个半唯一字段）都比让他们自己交互表要复杂得多（虽然通常不赞成，但在这种情况下，只要我们有一些跟踪，表暴露恰好不是问题）

手动生成的DataMacros是不灵活的—我无法将其任何部分复制粘贴到新表中，以快速更新我感兴趣的跟踪字段（添加、删除、更改等）。此数据库是新的，因此我希望随着时间的推移，随着新字段的添加，优先级和焦点会发生变化

解决方案：

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

限制：

如果不处理表达式中的空值，DataMacros将抛出错误

数据宏有255个字符的限制

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

公共表更改名称为字符串
公共表changedkey作为字符串
作为布尔值的公共日志
公共函数SetupLogEvent（ByVal TableName作为字符串，ByVal KeyName作为字符串）
'此函数按原样读取记录集以生成'before'字典
'通过用户表单更新时SuppressLog为True
“表格会成功的
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

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

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