Reputation: 17
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
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