andigirlsc
Registered User.
- Local time
- Today, 03:19
- Joined
- Jun 4, 2014
- Messages
- 59
I found some code online that creates an Audit Trail for my database. This code captures all changes (new records, edits and deletions) to my database and writes the changes (old and new values) to a table. It works, but it also gives an error message, “Object Doesn't Support Property or Method Error”.
I have seen other posts with this error, but not a solution specific to my needs. How do I get rid of this error? Thanks in advance!
Here is the actual code that I used in the form. This code was saved as a Module and is called in each form.
Audit Trail Code
http://www.fontstuff.com/access/acctut21.htm
Code to Call AuditChanges function for New or Edited Records
Here is the code to trigger AuditChanges upon a deletion. This code doesn’t trigger the error message. I isolated it and it ran fine.
I have seen other posts with this error, but not a solution specific to my needs. How do I get rid of this error? Thanks in advance!
Here is the actual code that I used in the form. This code was saved as a Module and is called in each form.
Audit Trail Code
http://www.fontstuff.com/access/acctut21.htm
Code:
[COLOR=black][COLOR=navy]Sub[/COLOR] AuditChanges(IDField [COLOR=navy]As String[/COLOR], UserAction [COLOR=navy]As String[/COLOR])
[COLOR=navy] On Error GoTo[/COLOR] AuditChanges_Err
[COLOR=navy] Dim[/COLOR] cnn [COLOR=navy]As[/COLOR] ADODB.Connection
[COLOR=navy] Dim[/COLOR] rst [COLOR=navy]As[/COLOR] ADODB.Recordset
[COLOR=navy] Dim[/COLOR] ctl [COLOR=navy]As[/COLOR] Control
[COLOR=navy] Dim[/COLOR] datTimeCheck [/COLOR][COLOR=black][COLOR=navy]As Date
Dim [/COLOR]strUserID[COLOR=navy] As String[/COLOR]
[COLOR=navy] Set[/COLOR] cnn = CurrentProject.Connection
[COLOR=navy] Set[/COLOR] rst = [COLOR=navy]New[/COLOR] ADODB.Recordset
rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = Environ("USERNAME")
[COLOR=navy] Select Case[/COLOR] UserAction
[COLOR=navy] Case[/COLOR] "EDIT"
[COLOR=navy] For[/COLOR] Each ctl [COLOR=navy]In[/COLOR] Screen.ActiveForm.Controls
[COLOR=navy] If[/COLOR] ctl.Tag = "Audit" [COLOR=navy]Then[/COLOR]
[COLOR=navy] If[/COLOR] Nz(ctl.Value) <> Nz(ctl.OldValue) [COLOR=navy]Then[/COLOR]
[COLOR=navy] With[/COLOR] rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![Action] = UserAction
![RecordID] = Screen.ActiveForm.Controls(IDField).Value
![FieldName] = ctl.ControlSource
![OldValue] = ctl.OldValue
![NewValue] = ctl.Value
.Update
[COLOR=navy] End With[/COLOR]
[COLOR=navy] End If[/COLOR]
[COLOR=navy] End If[/COLOR]
[COLOR=navy] Next[/COLOR] ctl
[COLOR=navy] Case Else[/COLOR]
[COLOR=navy] With[/COLOR] rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![Action] = UserAction
![RecordID] = Screen.ActiveForm.Controls(IDField).Value
.Update
[COLOR=navy] End With[/COLOR]
[COLOR=navy] End Select[/COLOR]
AuditChanges_Exit:
[COLOR=navy] On Error Resume Next[/COLOR]
rst.Close
cnn.Close
[COLOR=navy] Set[/COLOR] rst = [COLOR=navy]Nothing[/COLOR]
[COLOR=navy] Set[/COLOR] cnn = [COLOR=navy]Nothing[/COLOR]
[COLOR=navy] Exit[/COLOR] [COLOR=navy]Sub[/COLOR]
AuditChanges_Err:
MsgBox Err.Description, vbCritical, "ERROR!"
[COLOR=navy] Resume[/COLOR] AuditChanges_Exit
[COLOR=navy]End Sub[/COLOR][/COLOR]
Code to Call AuditChanges function for New or Edited Records
Code:
[COLOR=black][COLOR=navy]Private Sub[/COLOR] Form_BeforeUpdate(Cancel [COLOR=navy]As Integer[/COLOR])
[COLOR=navy] If[/COLOR] Me.NewRecord [COLOR=navy]Then[/COLOR]
[COLOR=navy] Call[/COLOR] AuditChanges("EmployeeID", "NEW")
[COLOR=navy] Else[/COLOR]
[COLOR=navy] Call[/COLOR] AuditChanges("EmployeeID", "EDIT")
[COLOR=navy] End If[/COLOR]
[COLOR=navy]End Sub[/COLOR][/COLOR]
Code:
Code to Call Audit Changes for Deletions
[COLOR=navy]Private Sub[/COLOR] Form_AfterDelConfirm(Status [COLOR=navy]As Integer[/COLOR])
[COLOR=navy] If[/COLOR] Status = acDeleteOK [COLOR=navy]Then Call[/COLOR] AuditChanges("EmployeeID", "DELETE")
[COLOR=navy]End Sub[/COLOR]