Rupert Bennett
Active Member
- Joined
- Nov 20, 2002
- Messages
- 276
I don't remember where I picked up this function to track changes, but I like it because it tracks changes in every form to every data entry control and keeps the changes in one centralized table.
The function works well for me, but only in cases where I am adding a new record. If i make changes to an existing record, i get an error message that says:
2424 The expression you entered has a field, control, or property name that Employee Attendance can't find.
Employee Attendance is the name of my Database.
The function is called from each form as follows:
Call Audit_Trail(Me, "EmployeeID", EmployeeID.Value). Of course the field name would change depending on which form you are auditing.
Here is the code:
Code:
Public Function Audit_Trail(MyForm As Form, UniqID_Field As String, UniqID As String)
On Error GoTo Err_Audit_Trail
'ACC2000: How to Create an Audit Trail of Record Changes in a Form
'http://support.microsoft.com/default.aspx?scid=kb;en-us;197592
'Dim MyForm As Form
Dim ctl As Control
Dim ccnt As Control
Dim sUser As String
Dim strSQL As String
Const cQUOTE = """" 'Thats 2 quotes in sequence
Dim action, nullval As String
nullval = "Null"
sUser = Environ("UserName") 'get the users login name
'If new record, record it in audit trail and exit function.
If MyForm.NewRecord = True Then
action = "*** New Record ***"
'Broken down into 4 separate variables for ease of view and troubleshooting
strSQL = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, [Action])"
strSQL = strSQL & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
strSQL = strSQL & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
strSQL = strSQL & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & action & cQUOTE & ";"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
Exit Function
End If
Dim changecnt As Integer
changecnt = 0
'Check each data entry control for change and record old value of the control.
For Each ccnt In MyForm.Controls
Select Case ccnt.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
If ccnt.Name Like "*" & "txt" & "*" Then GoTo TryNextCCNT 'Skip AuditTrail field.
If (ccnt.Value <> ccnt.OldValue) Or _
(IsNull(ccnt.Value) And Len(ccnt.OldValue) > 0 Or ccnt.Value = "" And Len(ccnt.OldValue) > 0) Then
changecnt = changecnt + 1
End If
End Select
TryNextCCNT:
Next ccnt
If changecnt > 0 Then
gstrReason = InputBox("Reason for change(s)?", "Reason for change(s)?")
End If
'Check each data entry control for change and record old value of the control.
For Each ctl In MyForm.Controls
'Only check data entry type controls.
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
If ctl.Name Like "*" & "txt" & "*" Then GoTo TryNextControl 'Skip AuditTrail field.
If ctl.Value <> ctl.OldValue Then
action = "*** Updated Record ***"
'Broken down into 4 separate variables for ease of view and troubleshooting
strSQL = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, Field, Prev_Value, New_Value, [Action], Reason)"
strSQL = strSQL & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
strSQL = strSQL & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
strSQL = strSQL & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & ctl.Name & cQUOTE & ", " & cQUOTE & ctl.OldValue & cQUOTE
strSQL = strSQL & ", " & cQUOTE & ctl.Value & cQUOTE & ", " & cQUOTE & action & cQUOTE & ", " & cQUOTE & gstrReason & cQUOTE & ";"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'If old value is Null and new value is not Null
ElseIf IsNull(ctl.OldValue) And Len(ctl.Value) > 0 Or ctl.OldValue = "" And Len(ctl.Value) > 0 Then
action = "*** Added Info to Record ***"
'Broken down into 4 separate variables for ease of view and troubleshooting
strSQL = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, Field, Prev_Value, New_Value, [Action])"
strSQL = strSQL & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
strSQL = strSQL & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
strSQL = strSQL & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & ctl.Name & cQUOTE & ", " & cQUOTE & nullval & cQUOTE
strSQL = strSQL & ", " & cQUOTE & ctl.Value & cQUOTE & ", " & cQUOTE & action & cQUOTE & ";"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'If new value is Null and old value is not Null
ElseIf IsNull(ctl.Value) And Len(ctl.OldValue) > 0 Or ctl.Value = "" And Len(ctl.OldValue) > 0 Then
action = "*** Removed Info to Record ***"
'Broken down into 4 separate variables for ease of view and troubleshooting
strSQL = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, Field, Prev_Value, New_Value, [Action], Reason)"
strSQL = strSQL & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
strSQL = strSQL & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
strSQL = strSQL & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & ctl.Name & cQUOTE & ", " & cQUOTE & ctl.OldValue & cQUOTE
strSQL = strSQL & ", " & cQUOTE & nullval & cQUOTE & ", " & cQUOTE & action & cQUOTE & ", " & cQUOTE & gstrReason & cQUOTE & ";"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
End Select
TryNextControl:
Next ctl
Exit_Audit_Trail:
Exit Function
Err_Audit_Trail:
If Err.Number = 2001 Then 'You canceled the previous operation.
'do nothing
Else
Beep
MsgBox Err.Number & " - " & Err.Description
End If
Resume Exit_Audit_Trail
End Function
Can anyone see what I am doing wrong and help me modify the code to work with my forms? the code works perfectly with the example that came with the code , even when new fields are added to the tables and forms.
I am using Access 2003.
Thanks for your help.
Rupert
The function works well for me, but only in cases where I am adding a new record. If i make changes to an existing record, i get an error message that says:
2424 The expression you entered has a field, control, or property name that Employee Attendance can't find.
Employee Attendance is the name of my Database.
The function is called from each form as follows:
Call Audit_Trail(Me, "EmployeeID", EmployeeID.Value). Of course the field name would change depending on which form you are auditing.
Here is the code:
Code:
Public Function Audit_Trail(MyForm As Form, UniqID_Field As String, UniqID As String)
On Error GoTo Err_Audit_Trail
'ACC2000: How to Create an Audit Trail of Record Changes in a Form
'http://support.microsoft.com/default.aspx?scid=kb;en-us;197592
'Dim MyForm As Form
Dim ctl As Control
Dim ccnt As Control
Dim sUser As String
Dim strSQL As String
Const cQUOTE = """" 'Thats 2 quotes in sequence
Dim action, nullval As String
nullval = "Null"
sUser = Environ("UserName") 'get the users login name
'If new record, record it in audit trail and exit function.
If MyForm.NewRecord = True Then
action = "*** New Record ***"
'Broken down into 4 separate variables for ease of view and troubleshooting
strSQL = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, [Action])"
strSQL = strSQL & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
strSQL = strSQL & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
strSQL = strSQL & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & action & cQUOTE & ";"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
Exit Function
End If
Dim changecnt As Integer
changecnt = 0
'Check each data entry control for change and record old value of the control.
For Each ccnt In MyForm.Controls
Select Case ccnt.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
If ccnt.Name Like "*" & "txt" & "*" Then GoTo TryNextCCNT 'Skip AuditTrail field.
If (ccnt.Value <> ccnt.OldValue) Or _
(IsNull(ccnt.Value) And Len(ccnt.OldValue) > 0 Or ccnt.Value = "" And Len(ccnt.OldValue) > 0) Then
changecnt = changecnt + 1
End If
End Select
TryNextCCNT:
Next ccnt
If changecnt > 0 Then
gstrReason = InputBox("Reason for change(s)?", "Reason for change(s)?")
End If
'Check each data entry control for change and record old value of the control.
For Each ctl In MyForm.Controls
'Only check data entry type controls.
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
If ctl.Name Like "*" & "txt" & "*" Then GoTo TryNextControl 'Skip AuditTrail field.
If ctl.Value <> ctl.OldValue Then
action = "*** Updated Record ***"
'Broken down into 4 separate variables for ease of view and troubleshooting
strSQL = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, Field, Prev_Value, New_Value, [Action], Reason)"
strSQL = strSQL & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
strSQL = strSQL & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
strSQL = strSQL & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & ctl.Name & cQUOTE & ", " & cQUOTE & ctl.OldValue & cQUOTE
strSQL = strSQL & ", " & cQUOTE & ctl.Value & cQUOTE & ", " & cQUOTE & action & cQUOTE & ", " & cQUOTE & gstrReason & cQUOTE & ";"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'If old value is Null and new value is not Null
ElseIf IsNull(ctl.OldValue) And Len(ctl.Value) > 0 Or ctl.OldValue = "" And Len(ctl.Value) > 0 Then
action = "*** Added Info to Record ***"
'Broken down into 4 separate variables for ease of view and troubleshooting
strSQL = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, Field, Prev_Value, New_Value, [Action])"
strSQL = strSQL & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
strSQL = strSQL & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
strSQL = strSQL & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & ctl.Name & cQUOTE & ", " & cQUOTE & nullval & cQUOTE
strSQL = strSQL & ", " & cQUOTE & ctl.Value & cQUOTE & ", " & cQUOTE & action & cQUOTE & ";"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
'If new value is Null and old value is not Null
ElseIf IsNull(ctl.Value) And Len(ctl.OldValue) > 0 Or ctl.Value = "" And Len(ctl.OldValue) > 0 Then
action = "*** Removed Info to Record ***"
'Broken down into 4 separate variables for ease of view and troubleshooting
strSQL = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, Field, Prev_Value, New_Value, [Action], Reason)"
strSQL = strSQL & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
strSQL = strSQL & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
strSQL = strSQL & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & ctl.Name & cQUOTE & ", " & cQUOTE & ctl.OldValue & cQUOTE
strSQL = strSQL & ", " & cQUOTE & nullval & cQUOTE & ", " & cQUOTE & action & cQUOTE & ", " & cQUOTE & gstrReason & cQUOTE & ";"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
End Select
TryNextControl:
Next ctl
Exit_Audit_Trail:
Exit Function
Err_Audit_Trail:
If Err.Number = 2001 Then 'You canceled the previous operation.
'do nothing
Else
Beep
MsgBox Err.Number & " - " & Err.Description
End If
Resume Exit_Audit_Trail
End Function
Can anyone see what I am doing wrong and help me modify the code to work with my forms? the code works perfectly with the example that came with the code , even when new fields are added to the tables and forms.
I am using Access 2003.
Thanks for your help.
Rupert