审核跟踪表单

Question

我正在为我的数据库中的表单设置审计跟踪系统。我跟随苏珊哈金斯的例子Here

我的代码适用于基于customers表的表单客户。这是我的代码：

Const cDQ As String = """"
Sub AuditTrail(frm As Form, recordid As Control)
'Track changes to data.
'recordid identifies the pk field's corresponding
'control in frm, in order to id record.
Dim ctl As Control
Dim varBefore As Variant
Dim varAfter As Variant
Dim strControlName As String
Dim strSQL As String
On Error GoTo ErrHandler
'Get changed values.
For Each ctl In frm.Controls
With ctl
'Avoid labels and other controls with Value property.
If .ControlType = acTextBox Then
If .Value <> .OldValue Then
MsgBox "Step 1"
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "Audit (EditDate, User, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
& cDQ & Environ("username") & cDQ & ", " _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .Name & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
End If
End With
Next
Set ctl = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description & vbNewLine _
& Err.Number, vbOKOnly, "Error"
End Sub

但是，当我尝试在表单中更改子表单中的数据时，我收到错误“此类对象不支持操作”。我可以看到错误发生在这里：

If .Value <> .OldValue Then

我的子表单基于一个基于三个表的查询

我正在尝试更改客户产品下的客户价格并记录这些更改。是否有我缺少的东西或解决方法。

感谢您的帮助！

Answer 1

暂时禁用错误处理程序，如下所示：

'On Error GoTo ErrHandler

当您收到有关“不支持操作”的错误通知时，请从错误对话框中选择“调试”。这将允许您找到有关触发错误的当前文本框控件的更多信息。在立即窗口中尝试以下语句：

? ctl.Name
? ctl.ControlSource
? ctl.Enabled
? ctl.Locked
? ctl.Value

至少ctl.Name将识别哪个文本框正在触发错误。

在检查db之后，我会建议一个函数（IsOldValueAvailable）来指示.OldValue是否可用于当前控件。使用该函数，AuditTrail过程在此更改后起作用：

'If .ControlType = acTextBox Then
If IsOldValueAvailable(ctl) = True Then

和功能。它可能仍然需要更多工作，但我在测试中没有发现任何问题。

Public Function IsOldValueAvailable(ByRef ctl As Control) As Boolean
    Dim blnReturn As Boolean
    Dim strPrompt As String
    Dim varOldValue As Variant

On Error GoTo ErrorHandler

    Select Case ctl.ControlType
    Case acTextBox
        varOldValue = ctl.OldValue
        blnReturn = True
    Case Else
        ' ignore other control types; return False
        blnReturn = False
    End Select

ExitHere:
    On Error GoTo 0
    IsOldValueAvailable = blnReturn
    Exit Function

ErrorHandler:
    Select Case Err.Number
    Case 3251 ' Operation is not supported for this type of object.
        ' pass
    Case Else
        strPrompt = "Error " & Err.Number & " (" & Err.Description _
            & ") in procedure IsOldValueAvailable"
        MsgBox strPrompt, vbCritical, "IsOldValueAvailable Function Error"
    End Select
    blnReturn = False
    Resume ExitHere
End Function