How to Create an Audit Trail of Changes in a Form 1

[uscitizen]

I cross posted this as a VBA thread but since it's overlapping with what may be a form feature, I thought better about not posting it here as well.

clicking will take you to MS'

http://support.microsoft.com/default.aspx?scid=kb;en-us;197592

freebie function which can be pasted into my application, and if the instructions are followed serve to record changes made to a form by a user.

So far so good, until I try to utilize the code in each of two linked (master and sub) forms.

To spell out the details a bit....

The instructions call for adding a memo field called Updates in the table underlying ones form, adding that field onto your form, and tagging the AuditTrail() function name onto the BeforeUpdates property field of the form.

The difficulty I'm encountering occurs when I have a linked (parent/child) master/sub-form pair on which I have applied the above modifications. What I find is that the Updates field on the master is modified whether I modify the master or the sub-form?

Being a VBA 'newbie' this seems puzzling to me.

Anyone care to speculate on the dynamics of this?

 

[MikeTompkins]

UsCitizen - I think your problem is the subform is actually a control on the main form-therefor an change on the subform shows as a change to the parent. The mickeysoft Knowledgebase has article Q210210 on this topic.

Michael

 

[uscitizen]

Hi -

I downloaded the q210210 and trying to digest it -- a bit overwhelming for a newbie -- but for the sake of argument, given you're hypothesis were correct, what would be the workaround (if anything)?

Thanks for the reference at any rate.

 

[uscitizen]

have you tried compiling it.....i am getting an 'invalid outside procedure' compile error.

 

[uscitizen]

wish i could retract the last eposting about getting a compilation error -- somehow the 'error' seems to have disolved into a false alarm

that was the good news, because the kb 210210 code works as advertised and tells me which which is which in my nested sub-forms in my database......the kb 197582 code which prompted the posting doesn't seem to know or care about this though :-(

 

[HomeALone]

The codes in 197592 only check controls in
acTextBox, acComboBox, acListBox, acOptionGroup. So subform is left alone. 197592 is designed not to be used in a form with subform. As a newbie, you need to learn a great deal on VBA in order to make a powerful audit trail for all kinds of differnt forms.

To get you start, read a book on VBA and check out this website:

http://users.bigpond.net.au/abrowne1/AppAudit.html

Good luck!

 

[uscitizen]

I would like to see whetherit could be done.

 

[MikeTompkins]

USCitizen - This might give you another option. Much of the code is from a few different MS Knowledgebase articles. There is quite a bit of code here, but you should only have to do the three things numbered below.

1. Create table named tblUpdated. The table has
five fields. The structure should be:
ID Number - autonumber
Username - text
Formname - text
Date - date/time (general format) default value of Date()+Time()
update -memo

2. In the beforeupdate event of all forms you wish to track place this code : Call AuditTrail(Me.Form.Name, Me.Form.NewRecord)

3. Create two modules for the code below. Code will track the user who made the change, the datetime stamp of when change was made and show the rest of audit trail info. If new record created it places "new record" at start of memo field.

4. I have kind of hacked a few different functions, so once you start playing with it you may want to clean things up.

Hope this helps.

Michael


Module for audittrail function
Option Compare Database
Option Explicit
Dim Screen_ActiveSubformControl As Control

Function AuditTrail(strFormname As String, newRec As Boolean)
On Error GoTo Err_Handler
Dim txtMessage As String
Dim db As Database
Dim rs As Recordset
Dim myform As Form, c As Control ', xName As String
Dim intcount As Integer
Set db = CurrentDb
Set myform = Screen.ActiveForm
Set rs = db.OpenRecordset("tblUpdated&quot
rs.AddNew

'call function from Module1
rs.Fields("UserName&quot = GetUserName
rs.Fields("formname&quot = strFormname
'default value of date field is date + time
' rs.Fields("Date&quot = Date

'If new record, record it in audit trail and exit sub.
If newRec = True Then
rs.Fields("Update&quot = "Added new record"
' GoTo ExitAuditTrail
End If



If DisplayActiveSubformName = "SubForm" Then
For intcount = 0 To Screen_ActiveSubformControl.Form.Controls.Count - 1
' MsgBox Screen_ActiveSubformControl.Form.Controls.Item(intcount)
' Debug.Print Screen_ActiveSubformControl.Form.Controls.Item(intcount).ControlName
'Only check data entry type controls.
Select Case Screen_ActiveSubformControl.Form.Controls.Item(intcount).ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
If (IsNull(Screen_ActiveSubformControl.Form.Controls.Item(intcount).OldValue) Or Screen_ActiveSubformControl.Form.Controls.Item(intcount).OldValue = "&quot And Not IsNull(Screen_ActiveSubformControl.Form.Controls.Item(intcount).Value) Then
rs.Fields("Update&quot = rs.Fields("Update&quot & Chr(13) & _
Chr(10) & Screen_ActiveSubformControl.Form.Controls.Item(intcount).Name & " was blank - now is " & Screen_ActiveSubformControl.Form.Controls.Item(intcount).Value
' If control had previous value, record previous value.
ElseIf Screen_ActiveSubformControl.Form.Controls.Item(intcount).Value <> Screen_ActiveSubformControl.Form.Controls.Item(intcount).OldValue Then
rs.Fields(&quot;Update&quot = rs.Fields(&quot;Update&quot & Chr(13) & Chr(10) & _
Screen_ActiveSubformControl.Form.Controls.Item(intcount).Name & &quot; was &quot; & Screen_ActiveSubformControl.Form.Controls.Item(intcount).OldValue & &quot; now is - &quot; & Screen_ActiveSubformControl.Form.Controls.Item(intcount).Value
End If

End Select
Next intcount

'MsgBox Screen.ActiveControl.ControlType
Else

'Check each data entry control for change and record
'old value of Control.
For Each c In myform.Controls

'Only check data entry type controls.
Select Case c.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
If (IsNull(c.OldValue) Or c.OldValue = &quot;&quot And Not IsNull(c.Value) Then
rs.Fields(&quot;Update&quot = rs.Fields(&quot;Update&quot & Chr(13) & _
Chr(10) & c.Name & &quot; was blank - now is &quot; & c.Value
' If control had previous value, record previous value.
ElseIf c.Value <> c.OldValue Then
rs.Fields(&quot;Update&quot = rs.Fields(&quot;Update&quot & Chr(13) & Chr(10) & _
c.Name & &quot; was &quot; & c.OldValue & &quot; now is - &quot; & c.Value
End If

End Select
TryNextC:
Next c

End If


ExitAuditTrail:
rs.Update
Set rs = Nothing
Set db = Nothing
Exit Function

Err_Handler:

If Err.Number <> 64535 Then
MsgBox &quot;Error #: &quot; & Err.Number & vbCrLf & &quot;Description: &quot; & Err.Description
End If
Resume TryNextC
End Function



'Type the following two procedures:
Function Set_Screen_ActiveSubformControl()
Dim frmActive As Form, ctlActive As Control
Dim hWndParent As Long

' Clear the control variable.
Set Screen_ActiveSubformControl = Nothing

' Assume a subform is not active.
Set_Screen_ActiveSubformControl = False

' Get the active form and control.
On Error Resume Next
Set frmActive = Screen.ActiveForm
Set ctlActive = Screen.ActiveControl
If Err <> 0 Then Exit Function

' Get the unique window handle identifying the form
' .. the active control is on.
hWndParent = ctlActive.Parent.Properties(&quot;hWnd&quot

' If the active form window handle is the same as the window
' handle of the form the active control is on, then we are on the
' mainform, so exit.
If hWndParent = frmActive.Hwnd Then Exit Function

' Find a subform control that has a window handle matching the
' .. window handle of the form the active control is on.
Set_Screen_ActiveSubformControl = FindSubform(frmActive, _
hWndParent)

End Function

Function FindSubform(frmSearch As Form, hWndFind As Long)
Dim i As Integer
On Error GoTo Err_FindSubForm

' Assume we will find a subform control with a window
' .. handle matching hWndFind.
FindSubform = True

' Visit each control on the form frmSearch.
For i = 0 To frmSearch.Count - 1
' If the control is a subform control...
If TypeOf frmSearch(i) Is SubForm Then
' .. does the window handle match the one we are looking
' for?
If frmSearch(i).Form.Hwnd = hWndFind Then
' We found it! Set the global control variable and exit.
Set Screen_ActiveSubformControl = frmSearch(i)
Exit Function
Else
' Otherwise, search this subform control (recursively)
' .. to see if it contains a sub-subform control
' .. with a window handle matching the one we are
' .. interested in.

' If we found a subform control, then exit.
If FindSubform(frmSearch(i).Form, hWndFind) Then
Exit Function
End If
End If
End If
Next i

Bye_FindSubform:
' If we didn't exit the function earlier, then there is no
' .. subform or sub-subform control on this form that has a window
' .. handle matching the one we are interested in, so return false.
FindSubform = False
Exit Function

Err_FindSubForm:
MsgBox Error$, 16, &quot;FindSubform&quot;
Resume Bye_FindSubform
End Function


Function DisplayActiveSubformName() As String
'if the current form is a subform we follow a different path in the function
'auditrail

If Set_Screen_ActiveSubformControl() = False Then
DisplayActiveSubformName = &quot;MainForm&quot;
Else
DisplayActiveSubformName = &quot;SubForm&quot;
End If


End Function





'Module Code from Microsoft articles to capture login name of user

Option Compare Database
Option Explicit

' Declare for call to mpr.dll.
Declare Function WNetGetUser Lib &quot;mpr.dll&quot; _
Alias &quot;WNetGetUserA&quot; (ByVal lpName As String, _
ByVal lpUserName As String, lpnLength As Long) As Long

Const NoError = 0 'The Function call was successful
Function GetUserName()

' Buffer size for the return string.
Const lpnLength As Integer = 255

' Get return buffer space.
Dim Status As Integer

' For getting user information.
Dim lpName, lpUserName As String

' Assign the buffer size constant to lpUserName.
lpUserName = Space$(lpnLength + 1)

' Get the log-on name of the person using product.
Status = WNetGetUser(lpName, lpUserName, lpnLength)

' See whether error occurred.
If Status = NoError Then
' This line removes the null character. Strings in C are null-
' terminated. Strings in Visual Basic are not null-terminated.
' The null character must be removed from the C strings to be used
' cleanly in Visual Basic.
lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
Else

' An error occurred.
lpUserName = &quot;NoLogin&quot;
' End
End If

' Display the name of the person logged on to the machine.
'MsgBox &quot;The person logged on this machine is: &quot; & lpUserName
GetUserName = lpUserName
End Function

 

[uscitizen]

Looks like something I can try just as soon as I can return to this part of the project.

Will get back with more feedback if warranted.

Major thanks

 

[uscitizen]

hi -

the long and the short of it is that i created two modules (module 3 and module 4) to take the code you created and added the command &quot;Call AuditTrail(Me.Form.Name, Me.Form.NewRecord&quot; in the BeforeUpdate property field of a form chosen at random from the universe of forms that will ultimately benefit from it in the database.

I made a few changes to the values of a record and when saving it was hit with a &quot;Can't find the macro
'Call AuditTrail(Me.Form.Name,Me.Form.NewRecord' &quot; 'informational' message.

Is the syntax in this field giving Access heartburn -- does it 'think' it's supposed to resolve the text from a list of macros?

 

[uscitizen]

this is kind of interesting.....

i did some further research into this (initial problem that prompted my query) after learning about google groups and discovered another's instance (using the kb 197592) that's resulting in the same phenomenon combined with what appears to be a workaround. i paste the url just fyi:

http://groups.google.com/groups?hl=...?q=audit+trail+group:microsoft.public.access.