Audit Trail Problem

[Guest]

Hi there,

I am currently busy writing a bit of generic code for the company to use in
many of it's access databases. It is for maintaining an audit trail of al
changes to records.

I have the following code on the form that needs to have tracking:

Option Compare Database

Private Declare Function getUserName Lib "advapi32.dll" Alias "GetUserNameA"
(ByVal lpBuffer As String, nSize As Long) As Long

Private Const MAX_BUFFER_LENGTH = 100

Private Function getLoggedUserName() As String 'User Defined Function
Dim strBufferString As String
Dim lngResult As Long
strBufferString = String(MAX_BUFFER_LENGTH, "X")
lngResult = getUserName(strBufferString, MAX_BUFFER_LENGTH)
getLoggedUserName = Mid(strBufferString, 1, MAX_BUFFER_LENGTH)
End Function


Private Sub Close_Form_Click()
On Error GoTo Err_Close_Form_Click


DoCmd.Close

Exit_Close_Form_Click:
Exit Sub

Err_Close_Form_Click:
MsgBox Err.Description
Resume Exit_Close_Form_Click

End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error Resume Next

' some controls may not have the Tag property ,
' hence the resume next

Dim blnCheckDiff As Boolean
Dim ctl As Control

For Each ctl In Me.Controls
blnCheckDiff = False
If ctl.Tag = "Check" Then
If ctl.Value <> ctl.OldValue Then
blnCheckDiff = True
Else
blnCheckDiff = False
End If
Else
blnCheckDiff = False
End If

If blnCheckDiff Then
Dim db
Set db = CurrentDb
db.Execute ("Insert into [AuditTrail]
(Fieldname,OldValue,NewValue,RecordID,FormName,ChangedDate,UserName) values
('" & ctl.Name & "','" _
& ctl.OldValue & "' , '" & ctl.Value & "' , '" & Me![DrName] & "' ,
'" & Me.Name & "' , '" & Now() & "','" & getLoggedUserName & "') ")
Set db = Nothing
Else
Cancel = True
End If
Next

End Sub


The problem is that when the before_update is invoked, it executes, but the
form does not continue it's operation. For example, when changing a value and
navigating to the next record, the change is tracked, but the change is not
saved in the database, and the form does not go on to the next record.

If anyone can help with this I'd be most grateful.

 

[Allen Browne]

As you probaby understand, you must use Form_BeforeUpdate, because the
OldValue of the fields is not available when Form_AfterUpdate fires. But, as
you say, there is no guarantee of the write succeeding when
Form_BeforeUpdate occurs.

It follows that you would need to build the SQL statement in
Form_BeforeUpdate, but execute it in Form_AfterUpdate. To do that, the
string would need to be declared in the General Declarations section of your
form (at the top, with the option statements.)

Your logic may not be handling nulls adequately. If the user enters a value
where the field was previously null, or deletes a value where there
previously was one, the line:
If ctl.Value <> ctl.OldValue Then
will not return True, so the Else will execute. That may not be what you
want.

A more problematic set of issues arise if you wish to log the deletion of
records. For an approach that does that, see:
Audit Trail - Log changes at the record level
at:
http://allenbrowne.com/AppAudit.html


BTW, I strongly advise that you add
Option Explicit
to the top of your module as well. It will save you no end of debugging.

--
Allen Browne - Microsoft MVP. Perth, Western Australia.

Reply to group, rather than allenbrowne at mvps dot org.

Hi there,

I am currently busy writing a bit of generic code for the company to use
in
many of it's access databases. It is for maintaining an audit trail of al
changes to records.

I have the following code on the form that needs to have tracking:

Option Compare Database

Private Declare Function getUserName Lib "advapi32.dll" Alias
"GetUserNameA"
(ByVal lpBuffer As String, nSize As Long) As Long

Private Const MAX_BUFFER_LENGTH = 100

Private Function getLoggedUserName() As String 'User Defined Function
Dim strBufferString As String
Dim lngResult As Long
strBufferString = String(MAX_BUFFER_LENGTH, "X")
lngResult = getUserName(strBufferString, MAX_BUFFER_LENGTH)
getLoggedUserName = Mid(strBufferString, 1, MAX_BUFFER_LENGTH)
End Function


Private Sub Close_Form_Click()
On Error GoTo Err_Close_Form_Click


DoCmd.Close

Exit_Close_Form_Click:
Exit Sub

Err_Close_Form_Click:
MsgBox Err.Description
Resume Exit_Close_Form_Click

End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error Resume Next

' some controls may not have the Tag property ,
' hence the resume next

Dim blnCheckDiff As Boolean
Dim ctl As Control

For Each ctl In Me.Controls
blnCheckDiff = False
If ctl.Tag = "Check" Then
If ctl.Value <> ctl.OldValue Then
blnCheckDiff = True
Else
blnCheckDiff = False
End If
Else
blnCheckDiff = False
End If

If blnCheckDiff Then
Dim db
Set db = CurrentDb
db.Execute ("Insert into [AuditTrail]
(Fieldname,OldValue,NewValue,RecordID,FormName,ChangedDate,UserName)
values
('" & ctl.Name & "','" _
& ctl.OldValue & "' , '" & ctl.Value & "' , '" & Me![DrName] & "'
,
'" & Me.Name & "' , '" & Now() & "','" & getLoggedUserName & "') ")
Set db = Nothing
Else
Cancel = True
End If
Next

End Sub


The problem is that when the before_update is invoked, it executes, but
the
form does not continue it's operation. For example, when changing a value
and
navigating to the next record, the change is tracked, but the change is
not
saved in the database, and the form does not go on to the next record.

If anyone can help with this I'd be most grateful.