Audit Trail not working in subform...

raghuprabhu

Registered User.
Local time
Yesterday, 16:40
Joined
Mar 24, 2008
Messages
154
Hi All,

I found this brilliant sample database posted on this fourm. It is working fine as for as the main form is concerned.

Does not do the updates in the subform. How do I do it?

In this case if I make any changes in fEmployees it is working. If I make change in fEmpPartner, it is putting a string in the main table "Changes made on 7/05/2011 1:21:53 PM by Admin;" Nothing more.

Thanks...
Raghu
 

Attachments

Hi All,

Found the solution. All I did was to make MyForm an input parameter for the sub "Audit_Trail" making it "Audit_Trail(MyForm As Form)"

Then in the code module of each form I changed the "Call Audit_Trail" to "Audit_Trail Me"

What is happening is that when the Form_BeforeUpdate event fires the reference to the form is passed to the Audit_Trail routine by using the reserved word "Me".
 

Attachments

Hi,

I'm so glad to have found your post. I've been banging my head with this audit trail stuff. However, I don't understand how to use this in my function. "MyForm!AuditTrail = MyForm!tbAuditTrail" Could you give me a hint? I downloaded your database and saw it in action, and would love to do the same thing.

Thanks so much!
Gina
 
Hi Gina,

Upload a sample of your database and I will tell you what to do.
 
Thanks! You ROCK! I did see how your process works, with the audit trail in the forms. I'm using a different function and was trying to combine your myform stuff into it. But now I just have a giant rat nest. Here's my original code:
Code:
Sub AuditChanges(IDField As String)
    On Error GoTo AuditChanges_Err
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim ctl As Control
    Dim datTimeCheck As Date
    Dim UserName As String
    Dim whoseonnow As Table
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
  
   rst.Open "SELECT * FROM AuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
     For Each ctl In Screen.ActiveForm.Controls
 
        If ctl.Tag = "Audit" Then
            If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                With rst
                    .AddNew
                    ![DateTime] = datTimeCheck
                    ![UserName] = DLookup("[currentuser]", "whoseonnow")
                    ![FormName] = Screen.ActiveForm.Name
                    ![ResidentID] = Screen.ActiveForm.Controls(IDField).Value
                    ![FieldName] = ctl.ControlSource
                    ![OldValue] = ctl.OldValue
                    ![NewValue] = ctl.Value
                    .Update
                End With
            End If
        End If
    Next ctl
AuditChanges_Exit:
    On Error Resume Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
AuditChanges_Err:
    MsgBox Err.Description, vbCritical, "ERROR!"
    Resume AuditChanges_Exit
End Sub

And then I run this on the before event of each form
Code:
 [FONT=Calibri]Private Sub Form_BeforeUpdate(cancel As Integer)[/FONT]
 [FONT=Calibri]    Call AuditChanges("residentid")[/FONT]
 [FONT=Calibri]End Sub[/FONT]

It works perfect on main forms. But doesn't trigger from subforms.

I'm afraid my db is too big to upload.

Thanks again for your assistance!!
Gina
 
Gina just take a copy of your database, in the copy delete all the extra bits, delete most of the data may be have one or two rows of data in the main form and one or two rows of data in the sub form. compress it then zip it an load it. That way I can quickly look at it, fix your sub form and upload it for you. BTW I use Access 2003 and 2007, what do you use?
 
Ok, I hope this works. I stripped a bunch of stuff out. The data is bogus. The form I'm working with is First Contact. And I've tried the function on the Client Allergies subform. The module is title basAudit. My audit table is Audit Table. Login with gina pw: dev. Thank you so much.
 
I got it working!!!! Please don't spend any more time on this. I thank you from the bottom of my heart for your willingness to help.

Have a wonderful day!!
Gina
 
Gina,
Congratulations on getting the thing working. what did you do???

Regards
Raghu
 
Well I'm afraid I did the happy dance a little too soon. With a great deal of help I got this to mostly work,

Code:
Sub AuditChanges(ByVal IDField As Control, Optional ByVal frm As Form = Nothing)
     On Error GoTo AuditChanges_Err
    Dim C As Control, xName As String
    
    Dim cnn         As ADODB.Connection
    Dim rst         As ADODB.Recordset
    Dim ctl         As Control
    Dim datTimeCheck As Date
    Dim UserName    As String
  
    
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    'Set idfield = Screen.ActiveForm.PrimaryKey
    rst.Open "SELECT * FROM AuditTrail where 1 = 0", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    'For Each ctl In frm.Controls 'Screen.ActiveForm.Controls
    If frm Is Nothing Then
        Set frm = Screen.ActiveForm
    End If
     For Each ctl In frm.Controls
        If ctl.ControlType = acSubform Then
            'TvS: Don't call recursively: subform has its own call to AuditChanges.
            'AuditChanges IDField, frm.Controls(ctl.ControlName).Form    'Object
        Else
            If ctl.Tag = "Audit" Then
                If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                    With rst
                        .AddNew
                        ![DateTime] = datTimeCheck
                        ![UserName] = DLookup("[currentuser]", "whoseonnow")
                        ![FormName] = GetFormName(frm) 'Screen.ActiveForm.Name
                        ![ResidentID] = Screen.ActiveForm.Controls("clientid").Value
                        ![FieldName] = ctl.ControlSource
                        ![OldValue] = ctl.OldValue
                        ![NewValue] = ctl.Value
                        .Update
                    End With
                End If
            End If
        End If
    Next ctl
AuditChanges_Exit:
    On Error Resume Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
AuditChanges_Err:
    MsgBox Err.Description, vbCritical, "ERROR!"
    Resume AuditChanges_Exit
    Resume
End Sub

However I need to call(?) the idfield dynamically, as it is not the same in all of my tables.
Code:
![ResidentID] = Screen.ActiveForm.Controls("clientid").Value

ClientID eventually becomes a ResidentID, and I have EmployeeIDs and Case Manager IDs. All of which will get audited. Do you know how I can do this?

I hope you had a great weekend!
Gina
 
Hi Gina

I am in the same situation as you with the same code - have you had any progress on making the code work for the subforms? Any comments or suggestions would be appreciated!

Thanks,
 
Yes! Here you go!

Code:
Option Compare Database
Option Explicit
Private Function GetFormName(frm As Form) As String
    Dim strFormName As String
    
    strFormName = frm.Name
    On Error Resume Next    'Because form may not have a parent.
    strFormName = frm.Parent.Name & "-" & strFormName
    
    GetFormName = strFormName
End Function
Private Function GetPkFieldName(frm As Form) As String
    Dim db As DAO.Database
    Dim fld As DAO.Field
    Dim idx As DAO.Index
    Dim td As DAO.TableDef
    
    Set db = CurrentDb
    For Each fld In frm.RecordsetClone.Fields
        Set td = db.TableDefs(fld.SourceTable)
        For Each idx In td.Indexes
            If idx.Primary = True Then
                Debug.Assert idx.Fields.Count = 1       'Cannot handle composite keys.
                GetPkFieldName = idx.Fields(0).Name
                Exit Function
            End If
        Next idx
    Next fld
Debug.Print
 End Function
Private Function GetControlBoundToFieldName(frm As Form, ByVal strFieldName As String) As Control
    Dim ctl As Control
    
    On Error Resume Next        'Not every control has a ControlSource property.
    For Each ctl In frm.Controls
        If ctl.ControlSource = strFieldName Then
            If Err.Number = 0 Then
                Set GetControlBoundToFieldName = ctl
                Exit Function
            Else
                Err.Clear
            End If
        End If
    Next ctl
End Function
 'Sub AuditChanges(MyForm As Form, IDField As Control)
'Sub AuditChanges(IDField As Control, Optional frm As Object = Nothing)
Sub AuditChanges(ByVal IDField As Control, Optional ByVal frm As Form = Nothing)
     On Error GoTo AuditChanges_Err
    Dim C As Control, xName As String
    'Set MyForm = Me 'Screen.ActiveForm
    Dim cnn         As ADODB.Connection
    Dim rst         As ADODB.Recordset
    Dim ctl         As Control
    Dim datTimeCheck As Date
    Dim UserName    As String
    'Dim whoseonnow As Table
    
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    'Set idfield = Screen.ActiveForm.PrimaryKey
    rst.Open "SELECT * FROM AuditTrail where 1 = 0", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    'For Each ctl In frm.Controls 'Screen.ActiveForm.Controls
    If frm Is Nothing Then
        Set frm = Screen.ActiveForm
     End If
     For Each ctl In frm.Controls
        If ctl.ControlType = acSubform Then
            'TvS: Don't call recursively: subform has its own call to AuditChanges.
            'AuditChanges IDField, frm.Controls(ctl.ControlName).Form    'Object
        Else
            If ctl.Tag = "Audit" Then
                If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                    With rst
                        .AddNew
                        ![DateTime] = datTimeCheck
                        ![UserName] = DLookup("[currentuser]", "whoseonnow")
                        ![FormName] = GetFormName(frm) 'Screen.ActiveForm.Name
                        '![audittrailpk] = Screen.ActiveForm.Controls(PK).Value
'![ResidentID] = GetControlBoundToFieldName(frm, GetPkFieldName(frm)).Value
![pk] = GetControlBoundToFieldName(frm, GetPkFieldName(frm)).Value
                        ![FieldName] = ctl.ControlSource
                        ![OldValue] = ctl.OldValue
                        ![NewValue] = ctl.Value
                        .Update
                    End With
                End If
            End If
        End If
    Next ctl
AuditChanges_Exit:
    On Error Resume Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
AuditChanges_Err:
    MsgBox Err.Description, vbCritical, "ERROR!"
    Resume AuditChanges_Exit
    Resume
End Sub

I hope this works for you. It's working great for me :-)
 
Wow that was a fast response, not to worry as I appeared to have found the solution to my own problem a minute or two after posting!

For anyone else who may be in the same situation - here's the code I am using now

Code:
Option Compare Database
Sub AuditChanges(IDField As String, UserAction As String)
    On Error GoTo AuditChanges_Err
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim ctl As Control
    Dim datTimeCheck As Date
    Dim strUserID As String
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM tbl_Audit", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    Select Case UserAction
        Case "EDIT"
            For Each ctl In Screen.ActiveForm.ActiveControl.Form
                If ctl.Tag = "Audit" Then
                    If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                        With rst
                            .AddNew
                            ![DateTime] = datTimeCheck
                            ![UserName] = strUserID
                            ![FormName] = Screen.ActiveForm.ActiveControl.Form.Name
                            ![Action] = UserAction
                            ![RecordID] = Screen.ActiveForm.ActiveControl.Form(IDField).Value
                            ![FieldName] = ctl.ControlSource
                            ![OldValue] = ctl.OldValue
                            ![NewValue] = ctl.Value
                            .Update
                        End With
                    End If
                End If
            Next ctl
        Case Else
            With rst
                .AddNew
                ![DateTime] = datTimeCheck
                ![UserName] = strUserID
                ![FormName] = Screen.ActiveForm.ActiveControl.Form.Name
                ![Action] = UserAction
                ![RecordID] = Screen.ActiveForm.ActiveControl.Form(IDField).Value
                .Update
            End With
    End Select
AuditChanges_Exit:
    On Error Resume Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
AuditChanges_Err:
    MsgBox Err.Description, vbCritical, "ERROR!"
    Resume AuditChanges_Exit
End Sub

The changes I made to the code that didn't work with subforms was editing both instances of;
![FormName] = Screen.ActiveForm.Name
![RecordID] = Screen.ActiveForm.Controls(IDField).Value
to;
![FormName] = Screen.ActiveForm.ActiveControl.Form.Name
![RecordID] = Screen.ActiveForm.ActiveControl.Form(IDField).Value

To be perfectly honest I have no idea what the difference is, I just tried it after reading something on Google. If anyone who knows a lot more than me on this subject (I am new and looking to learn, and improve!) could quickly explain the difference I would be grateful. As of this moment it's working for what I want, but I may come across more issues tomorrow.
 
Hello Raghu,

sorry to post this old thread,

I'm a just a beginner in Access, could you pls explain me or help how to solve this problem? :banghead:
I have the same issue, code working as a single form but not when I use it in a navigation form. by the way I use MS Access 2013.
I just went through the discussions below from this thread but couldn't quite figure out

Regards,
Prabhu
 
What worked for me, in each form or subform's before update event, put this code:
Call AuditChanges(Me.ID, Me).

The full module is:
Code:
'Sub AuditChanges(MyForm As Form, IDField As Control)
'Sub AuditChanges(IDField As Control, Optional frm As Object = Nothing)
Sub AuditChanges(ByVal IDField As Control, Optional ByVal frm As Form = Nothing)
     On Error GoTo AuditChanges_Err
    Dim C As Control, xName As String
    'Set MyForm = Me 'Screen.ActiveForm
    Dim cnn         As ADODB.Connection
    Dim rst         As ADODB.Recordset
    Dim ctl         As Control
    Dim datTimeCheck As Date
    Dim UserName    As String
    'Dim whoseonnow As Table
    
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    'Set idfield = Screen.ActiveForm.PrimaryKey
    rst.Open "SELECT * FROM AuditTrail where 1 = 0", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    'For Each ctl In frm.Controls 'Screen.ActiveForm.Controls
    If frm Is Nothing Then
        Set frm = Screen.ActiveForm
    End If
     For Each ctl In frm.Controls
        If ctl.ControlType = acSubform Then
            'TvS: Don't call recursively: subform has its own call to AuditChanges.
            'AuditChanges IDField, frm.Controls(ctl.ControlName).Form    'Object
        Else
            If ctl.Tag = "Audit" Then
                If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                    With rst
                        .AddNew
                        ![DateTime] = datTimeCheck
                        ![UserName] = DLookup("[currentuser]", "whoseonnow")
                        ![FormName] = GetFormName(frm) 'Screen.ActiveForm.Name
                        ![ResidentID] = Screen.ActiveForm.Controls("id").Value
                        ![FieldName] = ctl.ControlSource
                        ![OldValue] = ctl.OldValue
                        ![NewValue] = ctl.Value
                        .Update
                    End With
                End If
            End If
        End If
    Next ctl
AuditChanges_Exit:
    On Error Resume Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
AuditChanges_Err:
    MsgBox Err.Description, vbCritical, "ERROR!"
    Resume AuditChanges_Exit
    Resume
End Sub
 
Hi Bucephalus,

Post your database..

I will have a look and tell you...

Raghu
 
Hello everyone,

I think my thank you post was not posted, so resending..

Thank you for these useful post I will try to incorporate this to my accounting data base.

Your's truly,
Chino
 
Raghu,

here is the db.

Sub Form : HEX_BF_AllChanges
Parent Navigation form : HEX_BF_Navigation Form

the code from fontstuff's Martin Green is working perfect when I run the sub form 'HEX_BF_AllChanges' on stand alone but when this same form is run from the navigation form 'HEX_BF_Navigation Form' ,the code is not working.

could pls help?

Regards,
Prabhu
 

Attachments

Users who are viewing this thread

Back
Top Bottom