MS Access审计追踪功能运行失败报参数数量无效错误如何解决

核心故障点 #

• 拼写错误：代码中多处将Screen.ActiveForm误写为ScreenActiveForm，缺少成员访问符.，系统会将其识别为未定义的自定义函数/变量，调用时触发参数数量报错
• 记录集参数不匹配：你使用的是DAO原生记录集，调用OpenRecordset时却传入了ADO专属的游标常量adOpenDynamic，DAO方法不识别该参数，触发参数类异常
• 逻辑漏洞：正常执行完成的代码没有提前退出的逻辑，会无条件进入错误处理分支，即便功能正常也会弹出错误提示
• 隐式类型风险：未显式指定记录集类型为DAO.Recordset，当工程同时引用ADO、DAO库时可能出现类型不匹配问题

修复后完整代码 #

Public Function AuditChanges(RecordID As String, 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

Set DB = CurrentDb
' 仅读取表结构不加载历史数据，执行效率更高
Set rst = DB.OpenRecordset("select * from tbl_AuditTrail where 1=0", dbOpenDynaset)

UserLogin = Environ("UserName")
Select Case UserAction
    Case "New"
        With rst
            .AddNew
            ![DateTime] = Now()
            !UserName = UserLogin
            !FormName = Screen.ActiveForm.Name
            !Action = UserAction
            !RecordID = Screen.ActiveForm.Controls(RecordID).Value
            .Update
        End With
        
    Case "Delete"
        With rst
            .AddNew
            ![DateTime] = Now()
            !UserName = UserLogin
            !FormName = Screen.ActiveForm.Name
            !Action = UserAction
            !RecordID = Screen.ActiveForm.Controls(RecordID).Value
            .Update
        End With
        
    Case "Edit"
        For Each clt In Screen.ActiveForm.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 = Screen.ActiveForm.Name
                        !Action = UserAction
                        !RecordID = Screen.ActiveForm.Controls(RecordID).Value
                        !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
' 正常执行完直接退出，不进入错误处理分支
Exit Function

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

补充验证说明 #

替换代码后请先确认你的工程已经引用了Microsoft DAO x.x Object Library，同时确认tabl_AuditTrail表的字段名、字段类型和代码中赋值的字段完全匹配即可正常运行。

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