Audit Trail

[mike60smart]

Hi Everyone

I am trying to use Allan Browne's Audit Trail Code (http://allenbrowne.com/AppAudit.html) and I am getting the following error:-

The code on the Subform is as follows:-

Option Compare Database
Option Explicit

Sub AuditChangesSub(IDField As String, UserAction As String)
10        On Error GoTo AuditChangesSub_Err
          Dim cnn As ADODB.Connection
          Dim rst As ADODB.Recordset
          Dim ctl As Control
          Dim datTimeCheck As Date
          Dim strUserID As String
20        Set cnn = CurrentProject.Connection
30        Set rst = New ADODB.Recordset
40        rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
50        datTimeCheck = Now()
60        strUserID = Environ("USERNAME")
70        Select Case UserAction
              Case "EDIT"
80                For Each ctl In Screen.ActiveControl.Parent.Controls
90                    If ctl.Tag = "Audit" Then
100                       If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
110                           With rst
120                               .AddNew
130                               ![DateTime] = datTimeCheck
140                               ![UserName] = strUserID
150                               ![FormName] = Screen.ActiveControl.Parent.Form.Name
160                               ![Action] = UserAction
170                               ![RecordID] = Screen.ActiveControl.Parent.Form(IDField).Value
180                               ![FieldName] = ctl.ControlSource
190                               ![OldValue] = ctl.OldValue
200                               ![NewValue] = ctl.Value
210                               .Update
220                           End With
230                       End If
240                   End If
250               Next ctl
260           Case Else
270               With rst
280                   .AddNew
290                   ![DateTime] = datTimeCheck
300                   ![UserName] = strUserID
310                   ![FormName] = Screen.ActiveControl.Parent.Form.Name
320                   ![Action] = UserAction
330                   ![RecordID] = Screen.ActiveControl.Parent.Form(IDField).Value
340                   .Update
350               End With
360       End Select
AuditChangesSub_Exit:
370       On Error Resume Next
380       rst.CLOSE
390       cnn.CLOSE
400       Set rst = Nothing
410       Set cnn = Nothing
420       Exit Sub
AuditChangesSub_Err:
430       MsgBox Err.Description, vbCritical, "ERROR!"
440       Resume AuditChangesSub_Exit
End Sub

When I click a Command button to open another form I get the error message, hit Debug and it highlights Line 100

Does anyone have any thoughts on a solution for this?

Any helpappreciated

 

[Gasman]

Looks like you have put Audit where you should not have? Check all your controls.

 

[mike60smart]

Looks like you have put Audit where you should not have? Check all your controls.

Hi Gasman

Checked all the relevant Controls and they all have the correct Tag.

The strange thing is that even though I am getting the error message the table tblAuditTrail is recording the change

 

[Gasman]

Well perhaps see what control it is complaining about?
You know, just basic debugging, trying to actually delve a little deeper.?
I would be looking at the controls that should NOT have that tag?

 

[NauticalGent]

My guess (as I think Paul was suggesting), is that you assigned the Audit tag to a control that does not support the .Value method. Maybe put a "Debug.Print ctl.Name, ctl.ControlType" after line 90 to see which control the code is choking on.

 

[Pat Hartman]

If Nz(ctl.Value)

The Nz() function works differently in a query than it does in VBA. VBA allows you to omit the optional return value and VBA decides what to return based on the data type. Personally, I don't ever omit the return value when using Nz() because it means that the people reading the code need to understand that the value returned will be different depending on the data type. I understand why, in this context you cannot actually specify a return value. Therefore, I wouldn't use Nz(). Instead, I would use the following expression:

If ctl.Value & "" <> ctl.OldValue & "" Then

This avoids the issue and confusion of what Nz() returns in a particular situation. I don't know if it will solve the problem but keep in mind, not everyone on the Access team gets every memo and sometimes they don't read the ones they do get so over time, strange things get changed and maybe the return value being optional was one of them. I've run into multiple situations where expressions work differently in different situations. The Nz() being one of them. Ever notice that if you use a querydef for a crosstab query which takes one or more parameters that you have to specifically define each parameter and yet other query types don't require the specific definition? I've also run into places where external file names with multiple dots (Unix people go gonzo over dots) such as Somefile.2022.07.02.Docx cause Access to fail but in other areas, Access accepts them without complaint, etc.

 

[Gasman]

I was thinking a control that has no value property?
Allen Browne would probably not expect anyone to try and audit something that could not be changed via data amendment.?

 

[jdraw]

Mike,
You might want to read through this thread by PSSMargaret. I tried to understand the various attempts, but in the end
provided an alternative that satisfied her need.

I also did an audit trail with data macros.

 

[Gasman]

Mike,
You might want to read through this thread by PSSMargaret. I tried to understand the various attempts, but in the end
provided an alternative that satisfied her need.

I also did an audit trail with data macros.

That code looks identical to what Mike posted, but has a different author???

 

[mike60smart]

Hi Everyone

OK I got it working buy first of all deleting the Tag from all Controls.

Then added the Tag to 1 Control at a time and it now works just fine.

I went with Pats amendment to the NZ and that also works just fine.

Many thanks for the help.

 

[Gasman]

Well that is the long way to do it, but still, at least it now works.

 

[The_Doc_Man]

It is possible to run into certain cases that will whack you good with that loop.

First, be sure that everything tagged "Audit" has a .Value, because there are some controls that do not have .Value or .OldValue properties. The Line, Rectangle, Label, Sub-Form, Sub-Report, Command Buttons, and Option Buttons have no value or old value. (Option Group has the value - but the individual buttons do not.) But second, if there is a control that is unbound, it does not have a .OldValue even if it has .Value associated with it. That would mess up the .Nz pretty well.

I see that you added "Audit" one control at a time. That was tedious but - as you point out - it worked. Next time you want to add an audit, just remember that you can't audit things that don't have both a value and an old value. Well, except for unbound cases where you don't care that there is no old value, you just want what is there at the time of the audit. So call this a "future" contribution.

 

[jdraw]

That code looks identical to what Mike posted, but has a different author???

Paul,

The code that Margaret was using was from Martin Green (fontstuff.com). It is based on the same idea as the Allen Browne version, use form and record changes to a table. There are several flavors on various forums and sites.The Martin Green code (a sample database where she got her info) actually stored info about the wrong record which was part of Margaret's issue. Also it did not handle subform actions; her more serious problem.

I have not worked with the Allen Browne version.

 

[NauticalGent]

I also did an audit trail with data macros.

How did that work out?

 

[jdraw]

John,

There is a sample database in that thread that you are welcome to review.
The thread has several comments also.

That was a project to try to understand data macro. That's really the extent of my dabbling with the topic.

 

[Gasman]

Paul,

The code that Margaret was using was from Martin Green (fontstuff.com). It is based on the same idea as the Allen Browne version, use form and record changes to a table. There are several flavors on various forums and sites.The Martin Green code (a sample database where she got her info) actually stored info about the wrong record which was part of Margaret's issue. Also it did not handle subform actions; her more serious problem.

I have not worked with the Allen Browne version.

Well I was curious, and looked at the actual code from AB, which is this? http://allenbrowne.com/AppAuditCode.html

Nothing at all like the code Mike posted?
So it seems he copied that code by Martin Green and not Allen Browne, and just removed the credits?

 

[Pat Hartman]

When looping through controls, i usually includ their type to ensure I'm not bothering with controls I don't care about.

    For Each ctl In frm.Controls
       Select Case ctl.ControlType
            Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
                .....

 

[mike60smart]

Hi Gasman

My apologies but I did start off trying to use Allan Browne's Code but it did not deal with a Subform.

I must have looked on the net for a solution for Auditing Subforms and found the following Guide produced by Martin Green.

I didn't put the Credits in as I was not distributing the database,

This is the guide I used:-

 

[Gasman]

TBH if I use anyone's code ( and I have) and credits exist, I leave them well alone.
There was a situation on another site, where someone posted code without the credits that was written by Daniel Pinault. That persons appears innocent, as he was given the code by a colleague, who had removed the credits, so was unaware.
My view is, if credits exist, leave them well alone but then, that is just me.

You could even pass that code on to someone else on here by saying ' here is how I did it' and that just perpetuates the fraud.

Edit: Here is an example, which I am sure I posted here a good while back for someone else who wanted this functionality? This is in my very first Access DB from 2011.
Notice the
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
which might not be mentioned every time, but for me is implied.

Option Compare Database
Option Explicit
'************** Code Start *************
'This code was originally written by Jay Holovacs.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Jay Holovacs
'
Public Function mixed_case(str As Variant) As String
'returns modified string, first character of each word us uppercase
'all others lower case
Dim ts As String, ps As Integer, char2 As String
    If IsNull(str) Then
        mixed_case = ""
        Exit Function
    End If
    str = Trim(str) 'added 11/22/98
    If Len(str) = 0 Then
        mixed_case = ""
        Exit Function
    End If
    ts = LCase$(str)
    ps = 1
    ps = first_letter(ts, ps)
    Special_Name ts, 1 'try to fix the beginning
    Mid$(ts, 1) = UCase$(Left$(ts, 1))
    If ps = 0 Then
        mixed_case = ts
        Exit Function
    End If
    While ps <> 0
        If is_roman(ts, ps) = 0 Then 'not roman, apply the other rules
            Special_Name ts, ps
            Mid$(ts, ps) = UCase$(Mid$(ts, ps, 1)) 'capitalize the first letter
        End If
        ps = first_letter(ts, ps)
    Wend
    mixed_case = ts
End Function
Private Sub Special_Name(str As String, ps As Integer)
'expects str to be a lower case string, ps to be the
'start of name to check, returns str modified in place
'modifies the internal character (not the initial)
Dim iLen As Integer

Dim char2 As String
char2 = Mid$(str, ps, 2) 'check for Scots Mc
If (char2 = "mc") And Len(str) > ps + 1 Then '3rd char is CAP
    Mid$(str, ps + 2) = UCase$(Mid$(str, ps + 2, 1))
End If

char2 = Mid$(str, ps, 2) 'check for ff
If (char2 = "ff") And Len(str) > ps + 1 Then 'ff form
    Mid$(str, ps, 2) = LCase$(Mid$(str, ps, 2))
End If

'char2 = Mid$(str, ps + 1, 1) 'check for apostrophe as 2nd char
'If (char2 = "'") Then '3rd char is CAP
'    Mid$(str, ps + 2) = UCase$(Mid$(str, ps + 2, 1))
'End If

' Allow for a ' anywhere and then UCASE the next character
' Added by Paul Steel based on code above

For iLen = ps To Len(str)
    char2 = Mid$(str, iLen, 1) 'check for apostrophe
    If (char2 = "'") Then 'next char is CAP
        Mid$(str, iLen + 1) = UCase$(Mid$(str, iLen + 1, 1))
    End If
Next

Dim char3 As String
char3 = Mid$(str, ps, 3) 'check for scots Mac
If (char3 = "mac") And Len(str) > ps + 1 Then 'Mac form
    Mid$(str, ps + 3) = UCase$(Mid$(str, ps + 3, 1))
End If

Dim char4 As String
char4 = Mid$(str, ps, 4) 'check for Fitz
If (char4 = "fitz") And Len(str) > ps + 1 Then 'Fitz form
    Mid$(str, ps + 4) = UCase$(Mid$(str, ps + 4, 1))
End If

End Sub
Private Function first_letter(str As String, ps As Integer) As Integer
'ps=starting point to search (starts with character AFTER ps)
'returns next first letter, 0 if no more left
'modified 6/18/99 to handle hyphenated names
Dim p2 As Integer, p3 As Integer, s2 As String
    s2 = str
    p2 = InStr(ps, str, " ") 'points to next blank, 0 if no more
    p3 = InStr(ps, str, "-") 'points to next hyphen, 0 if no more
    If p3 <> 0 Then
        If p2 = 0 Then
            p2 = p3
        ElseIf p3 < p2 Then
            p2 = p3
        End If
    End If
    If p2 = 0 Then
        first_letter = 0
        Exit Function
    End If
    'first move to first non blank, non punctuation after blank
    While is_alpha(Mid$(str, p2)) = False
        p2 = p2 + 1
        If p2 > Len(str) Then 'we ran off the end
            first_letter = 0
            Exit Function
        End If
    Wend
    first_letter = p2
End Function
Public Function is_alpha(ch As String)
'returns true if this is alphabetic character
'false if not
    Dim c As Integer
    c = Asc(ch)
    Select Case c
        Case 65 To 90
            is_alpha = True
        Case 97 To 122
            is_alpha = True
        Case Else
            is_alpha = False
    End Select
   
End Function
Private Function is_roman(str As String, ps As Integer) As Integer
'starts at position ps, until end of word. If it appears to be
'a roman numeral, than the entire word is capped in passed back
'string, else no changes made in string
'returns 1 if changes were made, 0 if no change
Dim mx As Integer, p2 As Integer, flag As Integer, i As Integer
    mx = Len(str) 'just so we don't go off the edge
    p2 = InStr(ps, str, " ") 'see if there is another space after this word
    If p2 = 0 Then
        p2 = mx + 1
    End If
    'scan to see if any inappropriate characters in this word
    flag = 0
    For i = ps To p2 - 1
        If InStr("ivxIVX", Mid$(str, i, 1)) = 0 Then
            flag = 1
        End If
    Next i
    If flag Then
        is_roman = 0
        Exit Function 'this is not roman numeral
    End If
    Mid$(str, ps) = UCase$(Mid$(str, ps, p2 - ps))
    is_roman = 1
End Function
'************** Code End  *************

 

[mike60smart]

TBH if I use anyone's code ( and I have) and credits exist, I leave them well alone.
There was a situation on another site, where someone posted code without the credits that was written by Daniel Pinault. That persons appears innocent, as he was given the code by a colleague, who had removed the credits, so was unaware.
My view is, if credits exist, leave them well alone but then, that is just me.

You could even pass that code on to someone else on here by saying ' here is how I did it' and that just perpetuates the fraud.

Edit: Here is an example, which I am sure I posted here a good while back for someone else who wanted this functionality? This is in my very first Access DB from 2011.
Notice the
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
which might not be mentioned every time, but for me is implied.

Option Compare Database
Option Explicit
'************** Code Start *************
'This code was originally written by Jay Holovacs.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Jay Holovacs
'
Public Function mixed_case(str As Variant) As String
'returns modified string, first character of each word us uppercase
'all others lower case
Dim ts As String, ps As Integer, char2 As String
    If IsNull(str) Then
        mixed_case = ""
        Exit Function
    End If
    str = Trim(str) 'added 11/22/98
    If Len(str) = 0 Then
        mixed_case = ""
        Exit Function
    End If
    ts = LCase$(str)
    ps = 1
    ps = first_letter(ts, ps)
    Special_Name ts, 1 'try to fix the beginning
    Mid$(ts, 1) = UCase$(Left$(ts, 1))
    If ps = 0 Then
        mixed_case = ts
        Exit Function
    End If
    While ps <> 0
        If is_roman(ts, ps) = 0 Then 'not roman, apply the other rules
            Special_Name ts, ps
            Mid$(ts, ps) = UCase$(Mid$(ts, ps, 1)) 'capitalize the first letter
        End If
        ps = first_letter(ts, ps)
    Wend
    mixed_case = ts
End Function
Private Sub Special_Name(str As String, ps As Integer)
'expects str to be a lower case string, ps to be the
'start of name to check, returns str modified in place
'modifies the internal character (not the initial)
Dim iLen As Integer

Dim char2 As String
char2 = Mid$(str, ps, 2) 'check for Scots Mc
If (char2 = "mc") And Len(str) > ps + 1 Then '3rd char is CAP
    Mid$(str, ps + 2) = UCase$(Mid$(str, ps + 2, 1))
End If

char2 = Mid$(str, ps, 2) 'check for ff
If (char2 = "ff") And Len(str) > ps + 1 Then 'ff form
    Mid$(str, ps, 2) = LCase$(Mid$(str, ps, 2))
End If

'char2 = Mid$(str, ps + 1, 1) 'check for apostrophe as 2nd char
'If (char2 = "'") Then '3rd char is CAP
'    Mid$(str, ps + 2) = UCase$(Mid$(str, ps + 2, 1))
'End If

' Allow for a ' anywhere and then UCASE the next character
' Added by Paul Steel based on code above

For iLen = ps To Len(str)
    char2 = Mid$(str, iLen, 1) 'check for apostrophe
    If (char2 = "'") Then 'next char is CAP
        Mid$(str, iLen + 1) = UCase$(Mid$(str, iLen + 1, 1))
    End If
Next

Dim char3 As String
char3 = Mid$(str, ps, 3) 'check for scots Mac
If (char3 = "mac") And Len(str) > ps + 1 Then 'Mac form
    Mid$(str, ps + 3) = UCase$(Mid$(str, ps + 3, 1))
End If

Dim char4 As String
char4 = Mid$(str, ps, 4) 'check for Fitz
If (char4 = "fitz") And Len(str) > ps + 1 Then 'Fitz form
    Mid$(str, ps + 4) = UCase$(Mid$(str, ps + 4, 1))
End If

End Sub
Private Function first_letter(str As String, ps As Integer) As Integer
'ps=starting point to search (starts with character AFTER ps)
'returns next first letter, 0 if no more left
'modified 6/18/99 to handle hyphenated names
Dim p2 As Integer, p3 As Integer, s2 As String
    s2 = str
    p2 = InStr(ps, str, " ") 'points to next blank, 0 if no more
    p3 = InStr(ps, str, "-") 'points to next hyphen, 0 if no more
    If p3 <> 0 Then
        If p2 = 0 Then
            p2 = p3
        ElseIf p3 < p2 Then
            p2 = p3
        End If
    End If
    If p2 = 0 Then
        first_letter = 0
        Exit Function
    End If
    'first move to first non blank, non punctuation after blank
    While is_alpha(Mid$(str, p2)) = False
        p2 = p2 + 1
        If p2 > Len(str) Then 'we ran off the end
            first_letter = 0
            Exit Function
        End If
    Wend
    first_letter = p2
End Function
Public Function is_alpha(ch As String)
'returns true if this is alphabetic character
'false if not
    Dim c As Integer
    c = Asc(ch)
    Select Case c
        Case 65 To 90
            is_alpha = True
        Case 97 To 122
            is_alpha = True
        Case Else
            is_alpha = False
    End Select
  
End Function
Private Function is_roman(str As String, ps As Integer) As Integer
'starts at position ps, until end of word. If it appears to be
'a roman numeral, than the entire word is capped in passed back
'string, else no changes made in string
'returns 1 if changes were made, 0 if no change
Dim mx As Integer, p2 As Integer, flag As Integer, i As Integer
    mx = Len(str) 'just so we don't go off the edge
    p2 = InStr(ps, str, " ") 'see if there is another space after this word
    If p2 = 0 Then
        p2 = mx + 1
    End If
    'scan to see if any inappropriate characters in this word
    flag = 0
    For i = ps To p2 - 1
        If InStr("ivxIVX", Mid$(str, i, 1)) = 0 Then
            flag = 1
        End If
    Next i
    If flag Then
        is_roman = 0
        Exit Function 'this is not roman numeral
    End If
    Mid$(str, ps) = UCase$(Mid$(str, ps, p2 - ps))
    is_roman = 1
End Function
'************** Code End  *************

Hi Gasman
I looked at the guide provided by Martin and he does not ask for any Credits to be applied to the Code he provided.
If it was in the original Code then I would have included it.