Using Audit Trail on a Subform with a Different Primary Key (2 Viewers)

aestampa

New member
Local time
Today, 07:19
Joined
Sep 5, 2018
Messages
7
Hello Sir,
I am new on this access database code and i don't know if am doing right way. can you see if this is correct;
Code:
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 tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    strcomputername = Environ("computername")
    Select Case UserAction
        Case "EDIT"
            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] = strUserID
                            ![Computername] = strcomputername
                            ![FormName] = Screen.ActiveForm.Form.Name
                            ![Action] = UserAction
                            ![RecordID] = Screen.ActiveForm.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.Form.Name
                ![Action] = UserAction
                ![RecordID] = Screen.ActiveForm.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
 
Last edited by a moderator:

pbaldy

Wino Moderator
Staff member
Local time
Today, 06:19
Joined
Aug 30, 2003
Messages
36,118
Looks okay offhand; did you test it? I wouldn't open the recordset on the whole audit table. I don't use ADO much but I'd either use the argument that would open it for append only, or add a criteria to the SQL that won't return any records, like:

"SELECT * FROM tblAuditTrail WHERE 1=0"

or

"SELECT * FROM tblAuditTrail WHERE KeyFieldName = 0"
 

aestampa

New member
Local time
Today, 07:19
Joined
Sep 5, 2018
Messages
7
Looks okay offhand; did you test it? I wouldn't open the recordset on the whole audit table. I don't use ADO much but I'd either use the argument that would open it for append only, or add a criteria to the SQL that won't return any records, like:

"SELECT * FROM tblAuditTrail WHERE 1=0"

or

"SELECT * FROM tblAuditTrail WHERE KeyFieldName = 0"

Hello,
I did a test and error says, compile error: variable not defined

![Computername] = computername, maybe code is not correct format. Thanks
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 06:19
Joined
Aug 30, 2003
Messages
36,118
You need to declare the variable:

Dim strcomputername As String
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 06:19
Joined
Aug 30, 2003
Messages
36,118
Happy to help!
 

aestampa

New member
Local time
Today, 07:19
Joined
Sep 5, 2018
Messages
7
Happy to help!
Hello Sir,

I have another problem with code. I recently notice on tblaudittrail log is not showing new data input on NewValue. So when users enters new data on form and is not show on NewValue field on tblaudittrail. Thank you.
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 06:19
Joined
Aug 30, 2003
Messages
36,118
Are you talking about a new record, or the updated value when editing? How exactly are you calling the function, and from where?
 

aestampa

New member
Local time
Today, 07:19
Joined
Sep 5, 2018
Messages
7
Are you talking about a new record, or the updated value when editing? How exactly are you calling the function, and from where?

, Yes new record input, here is function;
Private Sub Form_BeforeUpdate(Cancel As Integer)

If Me.NewRecord Then
'Calls modAuditSub function to record new data to Audit Trail
Call AuditChangesSub("SubformPrimaryKey", "NEW") 'original

Else
'Calls modAuditSub function to record edits to Audit Trail
Call AuditChangesSub("SubformPrimaryKey", "EDIT") 'original

End If
End Sub
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 06:19
Joined
Aug 30, 2003
Messages
36,118
I'd set a breakpoint and follow the code. It should drop into the

Case Else

section and add a record. You can hover over variables while it's in debug mode and see what they contain.
 

aestampa

New member
Local time
Today, 07:19
Joined
Sep 5, 2018
Messages
7
I'd set a breakpoint and follow the code. It should drop into the

Case Else

section and add a record. You can hover over variables while it's in debug mode and see what they contain.
-----------------------------------------------------------------------------------
Is this correct?
Code:
  strUserID = Environ("USERNAME")
  strComputername = Environ("Computername")
    Select Case UserAction
        Case "EDIT"
            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] = strUserID
                            ![FormName] = Screen.ActiveForm.Form.Name
                            ![Action] = UserAction
                            ![RecordID] = Screen.ActiveForm.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.Form.Name
                ![Action] = UserAction
                ![RecordID] = Screen.ActiveForm.Form(IDField).Value
                .Update
            End With
    End Select
 
Last edited by a moderator:

Hobolobo

New member
Local time
Today, 14:19
Joined
Oct 2, 2018
Messages
2
Hi,

thank you for providing this detailed and helpful guide.
After adapting to it, the audit function for the main for works, but for the sub form I get "type mismatch" all the time. Where could the problem be?

Thank you in advance!
 

Hobolobo

New member
Local time
Today, 14:19
Joined
Oct 2, 2018
Messages
2
Hi,

thank you for providing this detailed and helpful guide.
After adapting to it, the audit function for the main for works, but for the sub form I get "type mismatch" all the time. Where could the problem be?

Thank you in advance!

Oh I actually found the reason.

Turns out it was because of the Primary Key form I used for the subform. It was "Replication ID" which is a different type as the RecordID within the Audit table and therefore, has caused the error.
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 06:19
Joined
Aug 30, 2003
Messages
36,118
Thanks for following up and welcome to AWF!
 

Giles64

New member
Local time
Tomorrow, 00:19
Joined
May 16, 2019
Messages
2
Hello and thanks for this solution, works great with my form/subform (Record Mgt/sfrmTransactions), my dilemma comes when I try and load this into the main form (Data Entry), then only the sfrmTransactions changes are logged in tblAuditTrail.

This is my setup, I have a main form with tabbed subforms, of those subforms some have embedded subforms

Form Name Primary Key Linked Master Linked Child
Data Entry JOBID
Record Mgt RID JOBID JOBID
sfrmTransactions RTID RID RID
Collections CID Runs Independently

I am thinking that as I have added another layer I may need to add another module? or maybe this wouldn't work with my scenario. I do not need all forms to be logged in the tblAuditTrail, only a few subforms, is this possible? I could leave the subforms I want logged out on their own but the preferred option is the tabbed subforms. Being self taught I do not have the experience yet, I would welcome and appreciate any help or suggestions on this matter. Thanks in advance.


Colleen
 

LilyK

New member
Local time
Today, 21:19
Joined
Feb 17, 2021
Messages
10
Solution
Here is the solution to getting the Audit Trail table to work on both the Main form and Subform simultaneously, even if they both have different primary keys and the Subform is based on a query (as in my case). As with most Subform/Audit Trail issues, the Main form sends data to the Audit Trail table, but the Subform does not. I have written out the exact code that will work based on the original code I found at fontstuff.com. All the leg work has been done for you, so enjoy!

Getting Started:
You must have the following in place before getting this code to work.

(1) You must have the Microsoft ActiveX Data Objects 2.8 Library added to your VBA Reference Library for the Audit Trail solution to work.
  • Open your Access database
  • Press CTRL+G to open the VBA window
  • Click Tools | References
  • Scroll to find the Microsoft ActiveX Data Objcts 2.8 Library
  • Check the box to add the reference library
  • Click OK
  • Click Save in the VBA window
(2) You need an Audit Trail table called "tblAuditTrail"

(3) You need the following fields in tblAuditTrail
Field Name, (Data Type)
- AuditTrailID, (Autonumber)
- DateTime, (Date/Time)
- UserName, (Text)
- FormName, (Text)
- Action, (Text)
- RecordID, (Text)
- FieldName, (Text)
- OldValue, (Text)
- NewValue, (Text)

(4) You need the Microsoft ActiveX Data Objects 2.8 Library.
To get it, open The VBA window and click | Tools | References | Scroll down to Microsoft ActiveX Data Objects 2.8 Library, check the box and click OK.

(5) Place the word "Audit" (without quotes) in the Tag property of all controls on the Main form and Subform.

(6) Create the Audit Trail module for the Main Form
Create a new module, name it "modAudit" and paste the following code. If your Audit Trail table is not named "tblAuditTrail" rename that table reference in your code after you paste it into your module. It's marked in blue.
Code:
Option Compare Database
Option Explicit

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 [COLOR="Blue"][B]tblAuditTrail[/B][/COLOR]", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    Select Case UserAction
        Case "EDIT"
            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] = strUserID
                            ![FormName] = Screen.ActiveForm.Form.Name
                            ![Action] = UserAction
                            ![RecordID] = Screen.ActiveForm.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.Form.Name
                ![Action] = UserAction
                ![RecordID] = Screen.ActiveForm.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

(7) Call the Audit Trail module from the Main Form
In the Before Update Event of the Main form, paste the following code. Replace "MainFormPrimaryKey" with the name of your Main Form's Primary Key in both lines of code.
Code:
Option Compare Database

Private Sub Form_BeforeUpdate(Cancel As Integer)

If Me.NewRecord Then
    'Calls modAudit function to record new records to Audit Trail
    Call AuditChanges("[B][COLOR="blue"]MainFormPrimaryKey[/COLOR][/B]", "NEW")

Else
    'Calls modAudit function to record edits to Audit Trail
    Call AuditChanges("[B][COLOR="blue"]MainFormPrimaryKey[/COLOR][/B]", "EDIT")

End If
End Sub

Now for the Subform...
Your Subform will have to call a separate module with slightly different code. This new module will have to be called from the Before Update Event of the Subform, not the Main form.

(8) Create the Audit Trail module for the Subform
Create a new module and name it "modAuditSub" and paste the following code. This will be the code used to call the Audit Trail from your Subform. The code in blue indicates the changes that make it possible for your Subform to trigger the Audit Trail while the Audit Trail simultaneously records changes from your Main form.
Code:
Option Compare Database
Option Explicit

Sub AuditChangesSub(IDField As String, UserAction As String)
    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
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    Select Case UserAction
        Case "EDIT"
            For Each ctl In [COLOR="blue"][B]Screen.ActiveControl.Parent.Controls[/B][/COLOR]
                If ctl.Tag = "Audit" Then
                    If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                        With rst
                            .AddNew
                            ![DateTime] = datTimeCheck
                            ![UserName] = strUserID
                            ![FormName] = [COLOR="blue"][B]Screen.ActiveControl.Parent.Form.Name[/B][/COLOR]
                            ![Action] = UserAction
                            ![RecordID] = [B][COLOR="blue"]Screen.ActiveControl.Parent.Form(IDField).Value[/COLOR][/B]
                            ![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] = [COLOR="blue"][B]Screen.ActiveControl.Parent.Form.Name[/B][/COLOR]
                ![Action] = UserAction
                ![RecordID] = [COLOR="Blue"][B]Screen.ActiveControl.Parent.Form(IDField).Value[/B][/COLOR]
                .Update
            End With
    End Select
AuditChangesSub_Exit:
    On Error Resume Next
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
AuditChangesSub_Err:
    MsgBox Err.Description, vbCritical, "ERROR!"
    Resume AuditChangesSub_Exit
End Sub

(9) Call the Audit Trail module from the Subform
In the Before Update Event of the Subform, paste the following code. Replace "SubFormPrimaryKey" with the name of your SubForm's Primary Key in both lines of code.
Code:
Option Compare Database

Private Sub Form_BeforeUpdate(Cancel As Integer)

If Me.NewRecord Then
    'Calls modAuditSub function to record new data to Audit Trail
    Call AuditChangesSub("[B][COLOR="blue"]SubformPrimaryKey[/COLOR][/B]", "NEW") 'original

Else
    'Calls modAuditSub function to record edits to Audit Trail
    Call AuditChangesSub("[COLOR="blue"][B]SubformPrimaryKey[/B][/COLOR]", "EDIT") 'original

End If
End Sub

That's all there is to it. :)
Hey @andigirlsc . Thank you so much for the template. Well appreciated.

here i have one question..
How to track the deleted record? Edit and new worked well for my database but i need one more which is delete . Thank you!😊
 
Last edited:

jdraw

Super Moderator
Staff member
Local time
Today, 09:19
Joined
Jan 23, 2006
Messages
15,362
See post # 13 in this thread. There is a solution for main and subforms and a link to a separate discussion with PSSMargaret who identified a problem with the original code from Martin Green.

For another approach to audit trail which works for direct table changes, queries or form based events see this link posts 11, 14 and a sample database with audit trail in post #21.

Good luck with you project.
 

baig1984

New member
Local time
Today, 13:19
Joined
Feb 18, 2021
Messages
9
Not working..... if i keep the [Color=Blue"] it keeps giving error, removing it does not store data


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 tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = Environ("USERNAME")
Select Case UserAction
Case "EDIT"
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] = strUserID
![FormName] = Screen.ActiveForm.Form.Name
![Action] = UserAction
![RecordID] = Screen.ActiveForm.Form("F_ID").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.Form.Name
![Action] = UserAction
![RecordID] = Screen.ActiveForm.Form("F_ID").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
 

Users who are viewing this thread

Top Bottom