Microsoft Access VBA审计追踪代码报错，请求问题排查

我在Microsoft Access中创建了包含员工数据（姓名、部门、经理等）的数据库，以及用于录入和编辑员工数据的窗体。随后通过VBA代码创建了名为"Audit Trail"的模块实现审计追踪，记录数据变更操作，并将该模块与窗体的"Before Update"事件过程关联。但修改数据或创建新员工档案时出现报错，请帮忙排查缺失的配置或代码问题。

Audit Trail模块原代码 #

Option Compare Database 
Public Function AuditChanges(RecordID As Double, UserAction As String) 
    On Error GoTo auditerr 

    Dim DB As Database 
    Dim rst As Recordset 
    Dim clt As Control 
    Dim UserLogin As String 

    Set DB = CurrentDb 
    Set rst = DB.OpenRecordset("select * from Audit_Trail", adOpenDynamic) 

    UserLogin = Environ("Username") 

    Select Case UserAction 
        Case "New" 
            With rst 
                .AddNew 
                ![DateTime] = Now() 
                !UserName = UserLogin 
                !FormName = Employee_Master_Data_Input 
                !Action = UserAction 
                !RecordID = Employee_Master_Data_Input(EmpID).Value 
                .Update 
                .MoveNext ' Move to the next record 
                 
            End With 
             
         Case "Delete" 
            With rst 
                .AddNew 
                ![DateTime] = Now() 
                !UserName = UserLogin 
                !FormName = Employee_Master_Data_Input 
                !Action = UserAction 
                !RecordID = Employee_Master_Data_Input(EmpID).Value 
                .Update 
                .MoveNext ' Move to the next record 
                 
            End With 

        Case "Edit" 
            For Each clt In Employee_Master_Data_Input 
                If (clt.ControlType = acTextBox _ 
                 Or clt.ControlType = acComboBox) Then 
                 If Nz(clt.Value) <> Nz(clt.OldValue) Then 
                        With rst 
                            .AddNew 
                            ![DateTime] = Now() 
                            !UserName = UserLogin 
                            !FormName = Employee_Master_Data_Input 
                            !Action = UserAction 
                            !RecordID = Employee_Master_Data_Input(EmpID).Value 
                            !FieldName = clt.ControlSource 
                            !OldValue = clt.OldValue 
                            !NewValue = clt.Value 
                            .Update 
                            .MoveNext ' Move to the next record 
                             
                        End With 
                    End If 
                End If 
            Next clt 
    End Select 

    rst.Close 
    DB.Close 
    Set rst = Nothing 
    Set DB = Nothing 

    Exit Function 

auditerr: 
    ' MsgBox Err.Number & " : " & Err.Description, vbCritical, "Error" 
    Exit Function 

End Function 

窗体Before Update事件原代码 #

Private Sub Form_BeforeUpdate(Cancel As Double) 
    If Me.NewRecord Then 

    Call AuditChanges("RecordID", "New") 
Else 
    Call AuditChanges("RecordID", "Edit") 
     
End If 
End Sub

问题排查与修正方案 #

1. 参数传递与类型错误

• Form_BeforeUpdate事件的Cancel参数类型错误，Access中该参数应为Integer而非Double。
• 调用AuditChanges时传入的第一个参数是字符串"RecordID"，但函数要求Double类型的实际记录ID值，应改为Me.EmpID.Value（新增记录时用Nz(Me.EmpID, 0)避免空值）。

修正后的事件代码：

Private Sub Form_BeforeUpdate(Cancel As Integer)
    If Me.NewRecord Then
        Call AuditChanges(Nz(Me.EmpID, 0), "New")
    Else
        Call AuditChanges(Me.EmpID.Value, "Edit")
    End If
End Sub

2. 窗体引用方式错误

代码中直接使用Employee_Master_Data_Input引用窗体，会导致窗体未打开或不是当前窗体时出错。正确做法是使用窗体名称字符串，或通过Me引用当前窗体，同时明确遍历窗体的Controls集合。

3. Recordset对象库引用问题

OpenRecordset使用adOpenDynamic属于ADO对象，若未引用ADO库会报错。建议改用DAO对象库（Access默认更稳定），声明对象时添加DAO.前缀，使用dbOpenDynaset作为打开类型。

4. 多余的MoveNext操作

在AddNew并Update后执行MoveNext无意义，新增记录已成为当前记录，移动到下一条会导致后续操作偏离预期，应删除该语句。

5. 错误处理失效

原代码注释掉了错误提示，取消注释可查看具体错误信息，便于精准排查。

修正后的Audit Trail模块代码 #

Option Compare Database
Public Function AuditChanges(RecordID As Double, UserAction As String)
    On Error GoTo auditerr

    Dim DB As DAO.Database
    Dim rst As DAO.Recordset
    Dim clt As Control
    Dim UserLogin As String
    Dim frm As Form

    Set DB = CurrentDb
    Set rst = DB.OpenRecordset("Audit_Trail", dbOpenDynaset)
    Set frm = Me ' 引用当前触发事件的窗体，无需硬编码窗体名称

    UserLogin = Environ("Username")

    Select Case UserAction
        Case "New"
            With rst
                .AddNew
                ![DateTime] = Now()
                !UserName = UserLogin
                !FormName = frm.Name ' 存储窗体名称字符串
                !Action = UserAction
                !RecordID = RecordID
                .Update
            End With

        Case "Delete"
            With rst
                .AddNew
                ![DateTime] = Now()
                !UserName = UserLogin
                !FormName = frm.Name
                !Action = UserAction
                !RecordID = RecordID
                .Update
            End With

        Case "Edit"
            For Each clt In frm.Controls
                If (clt.ControlType = acTextBox Or clt.ControlType = acComboBox) Then
                    If Nz(clt.Value) <> Nz(clt.OldValue) Then
                        With rst
                            .AddNew
                            ![DateTime] = Now()
                            !UserName = UserLogin
                            !FormName = frm.Name
                            !Action = UserAction
                            !RecordID = RecordID
                            !FieldName = clt.ControlSource
                            !OldValue = clt.OldValue
                            !NewValue = clt.Value
                            .Update
                        End With
                    End If
                End If
            Next clt
    End Select

    rst.Close
    DB.Close
    Set rst = Nothing
    Set DB = Nothing
    Set frm = Nothing

    Exit Function

auditerr:
    MsgBox Err.Number & " : " & Err.Description, vbCritical, "审计追踪错误"
    Exit Function

End Function

内容的提问来源于stack exchange，提问作者Narada Jayasekara