Turtle
Turtle

Reputation: 17

Reserved Error when capturing changes on Access 2013 Form

I'm using the code within the following link within an Access 2013 form to capture changes made to records: https://www.techrepublic.com/article/a-simple-solution-for-tracking-changes-to-access-data/

I have the ErrorHandler commented out and am getting a "<Reserved Error>" within the line: If (.Value <> .OldValue or ((Not IsNull .... This causes the statement not to read True and is skipped over.

I'm calling this Sub in BeforeUpdate trigger on the Review Form:

Sub ReviewFormAuditTrail(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
    Dim ChangeReason As Variant
    '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 = acComboBox Then
      'Changed this is allow for both null to value and value to null
       If (.Value <> .OldValue) Or ((Not IsNull(.OldValue) And IsNull(.Value))) Or ((IsNull(.OldValue) And Not IsNull(.Value))) Then
        varBefore = .OldValue
        varAfter = .Value
        strControlName = .Name
        ChangeReason = Forms![Review Form]!ChangeReason
        'Build INSERT INTO statement.
        strSQL = "INSERT INTO " _
           & "xAudit (EditDate, User, RecordID, SourceTable, " _
           & " SourceField, BeforeValue, AfterValue, ChangeReason) " _
           & "VALUES (Now()," _
           & cDQ & Environ("username") & cDQ & ", " _
           & cDQ & recordid.Value & cDQ & ", " _
           & cDQ & frm.RecordSource & cDQ & ", " _
           & cDQ & .Name & cDQ & ", " _
           & cDQ & varBefore & cDQ & ", " _
           & cDQ & varAfter & cDQ & "," _
           & cDQ & ChangeReason & cDQ & ")"
        'View evaluated statement in Immediate window.
        Debug.Print strSQL
        DoCmd.SetWarnings False
        DoCmd.RunSQL strSQL
        DoCmd.SetWarnings True
      End If

    ElseIf .ControlType = acTextBox Then
      'Changed this is allow for both null to value and value to null
      If (.Value <> .OldValue) Or ((Not IsNull(.OldValue) And IsNull(.Value))) Or ((IsNull(.OldValue) And Not IsNull(.Value))) Then
        varBefore = .OldValue
        varAfter = .Value
        strControlName = .Name
        ChangeReason = Forms![Review Form]!ChangeReason
        'Build INSERT INTO statement.
        strSQL = "INSERT INTO " _
           & "xAudit (EditDate, User, RecordID, SourceTable, " _
           & " SourceField, BeforeValue, AfterValue, ChangeReason) " _
           & "VALUES (Now()," _
           & cDQ & Environ("username") & cDQ & ", " _
           & cDQ & recordid.Value & cDQ & ", " _
           & cDQ & frm.RecordSource & cDQ & ", " _
           & cDQ & .Name & cDQ & ", " _
           & cDQ & varBefore & cDQ & ", " _
           & cDQ & varAfter & cDQ & "," _
           & cDQ & ChangeReason & 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

'Added to ignore the error produced from processing in joined tables
ErrHandler:
'If Err.Number = 3251 Then
'    Response = acDataErrContinue
'Else
'    MsgBox Err.Description & vbNewLine _
'    & Err.Number, vbOKOnly, "Error"
'End If
End Sub

Upvotes: 1

Views: 168

Answers (1)

Parfait
Parfait

Reputation: 107567

Consider the industry standard when using SQL at application layer (i.e., VBA) by using a parameterized query with MS Access' QueryDef.Parameters which I assume is the crux of your issue.

With this approach you divorce SQL from VBA for better readability and maintainability without need to concatenate or enclose with quotes. Your above link runs a VBA concatenated SQL string and curiously does not combine the two repetitive If blocks:

SQL (save as you would any MS Access query)

PARAMETERS paramEditDate Date, paramUser Text(255), paramRecordID Long, 
           paramSourceTable Text(255), paramSourceField Text(255), 
           paramBeforeValue Text(255), paramAfterValue Text(255), paramChangeReason Text(255);
INSERT INTO xAudit (EditDate, [User], RecordID, SourceTable
                    SourceField, BeforeValue, AfterValue, ChangeReason)
VALUES (paramEditDate, paramUser, paramRecordID, paramSourceTable,
        paramSourceField, paramBeforeValue, paramAfterValue, paramChangeReason);

VBA (pass form name as argument and use Forms() collection)

Sub ReviewFormAuditTrail(frm_name As String, recordid As Control)
On Error GoTo ErrHandler    
    '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, varAfter As Variant, ChangeReason As Variant
    Dim strControlName As String, strSQL As String
    Dim qdef As QueryDef

    'Get changed values.
    For Each ctl In Forms(frm_name).Controls
       With ctl
          'Avoid labels and other controls with Value property.
          If .ControlType = acComboBox Or .ControlType = acTextBox Then
             'Changed this is allow for both null to value and value to null
              If (.Value <> .OldValue) Or ((Not IsNull(.OldValue) And IsNull(.Value))) _
                Or ((IsNull(.OldValue) And Not IsNull(.Value))) Then

                   varBefore = .OldValue
                   varAfter = .Value
                   strControlName = .Name
                   ChangeReason = Forms![Review Form]!ChangeReason

                   ' RETRIEVE SAVED QUERY
                   Set qdef = CurrentDb.QueryDefs("mySavedQuery")

                   ' BIND PARAMS
                   qdef!paramEditDate = Now()
                   qdef!paramUser = Environ("username")
                   qdef!paramRecordID = recordid.Value
                   qdef!paramSourceTable = Forms(frm_name).RecordSource
                   qdef!paramSourceField = strControlName
                   qdef!paramBeforeValue = varBefore
                   qdef!paramAfterValue = varAfter
                   qdef!paramChangeReason = ChangeReason

                   ' EXECUTE QUERY
                   qdef.Execute dbFailOnError

              End If
          End if
       End With
    Next ctl

ExitHandler:
   Set ctl = Nothing: Set qdef = Nothing
   Exit Sub 

ErrHandler:
  MsgBox Err.Description & vbNewLine & Err.Number, vbOKOnly, "Runtime Error"
  Resume ExitHandler
End Sub

Upvotes: 1

Related Questions