Audit Track a form

2019-08-10 10:51发布

问题:

I am setting up a Audit Tracking system for the forms in my database. I am following the example from Susan Harkins Here

My code works for my form customers which is based off the customers table. Here is my code:

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

However, when I try to change data in my subform within the form I get an error "Operation is not supported for this type of object". I can see the error is occuring here:

If .Value <> .OldValue Then

My subform is based off of a query which is based off of three tables

I'm trying to change a customer price under Customer Products and keep a log of those changes. Is there something I'm missing or a work around.

Thank you for the help!

回答1:

Temporarily disable your error handler like this:

'On Error GoTo ErrHandler

When you get the error notice about "operation not supported", choose Debug from the error dialog. That will allow you to find out more information about the current text box control which is triggering the error. Try the following statements in the Immediate window:

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

At least ctl.Name will identify which text box is triggering the error.

After examining the db, I'll suggest a function (IsOldValueAvailable) to indicate whether .OldValue is available for the current control. With that function, the AuditTrail procedure works after this change:

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

And the function. It may still need more work, but I didn't spot any problems in my testing.

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