审计跟踪形式(Audit Track a form)

2019-10-17 13:28发布

我在我的数据库中的形式建立审计跟踪系统。 我下面从苏珊·哈金斯的例子在这里

我的代码工作为这是基于关闭客户表我的客户的形式。 这里是我的代码:

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


文章来源: Audit Track a form