Audit trail on changes made on table shown in a subform

F

fritz.panganiban

Registered User.
Local time
Yesterday, 20:29
Joined
Jul 31, 2014
Messages
42
Hi MS Access Experts,

Please spare me a piece of your time to help me with this brain cracking code which will supposedly track the changes made in the table shown in a subform.

Note that the table in a subform is not locked and enabled so as to allow user to make changes although user has to access the form with a password. The only problem I have is that, it does not make any record of edits.

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 tbl_AuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Forms!frmMainForm!txtUser
    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
and here's the code under Before Update event:
Code: 
 Private Sub Form_BeforeUpdate(cancel As Integer)
     Call AuditChanges("ID")
 End Sub
 
Last edited:
i have modified this , but don't know if it is still works on you situation:
Code: 
' ================================================
' Code by Martin Green Email: martin@fontstuff.com
' Visit my Office Tips website @ www.fontstuff.com
' YouTube tutorials www.youtube.com/martingreenvba
'
' modified by arnelgp
' 19 january 2016
' ================================================
'
' call on before update event of the form
Sub AuditChanges(IDField As String, UserAction As String, f As Access.Form)
    On Error GoTo AuditChanges_Err
    'Dim cnn As ADODB.Connection
    'Dim rst As ADODB.Recordset
    Dim rst As DAO.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
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblAuditTrail Where (1=0);", dbOpenDynaset)
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    Select Case UserAction
        Case "EDIT"
            'For Each ctl In Screen.ActiveForm.Controls
            For Each ctl In f
                If TypeOf f Is SubForm Then
                Else
                    If ctl.tag = "Audit" Then
                        If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                            With rst
                                .AddNew
                                ![DateTime] = datTimeCheck
                                ![username] = strUserID
                                '![FormName] = Screen.ActiveForm.Name
                                ![FormName] = f.Name
                                ![action] = UserAction
                                '![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                                ![recordid] = f.Controls(IDField).Value
                                ![fieldName] = ctl.ControlSource
                                ![OldValue] = ctl.OldValue
                                ![newValue] = ctl.Value
                                .Update
                            End With
                        End If
                    End If
                End If
            Next ctl
        Case Else
            With rst
                .AddNew
                ![DateTime] = datTimeCheck
                ![username] = strUserID
                '![FormName] = Screen.ActiveForm.Name
                ![FormName] = f.Name
                ![action] = UserAction
                '![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                ![recordid] = f.Controls(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

you pass the form as the third argument:

AuditChanges "ID", "Edit", Me
 
arnelgp said:
i have modified this , but don't know if it is still works on you situation:
Code: 
' ================================================
' Code by Martin Green Email: martin@fontstuff.com
' Visit my Office Tips website @ www.fontstuff.com
' YouTube tutorials www.youtube.com/martingreenvba
'
' modified by arnelgp
' 19 january 2016
' ================================================
'
' call on before update event of the form
Sub AuditChanges(IDField As String, UserAction As String, f As Access.Form)
    On Error GoTo AuditChanges_Err
    'Dim cnn As ADODB.Connection
    'Dim rst As ADODB.Recordset
    Dim rst As DAO.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
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblAuditTrail Where (1=0);", dbOpenDynaset)
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    Select Case UserAction
        Case "EDIT"
            'For Each ctl In Screen.ActiveForm.Controls
            For Each ctl In f
                If TypeOf f Is SubForm Then
                Else
                    If ctl.tag = "Audit" Then
                        If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                            With rst
                                .AddNew
                                ![DateTime] = datTimeCheck
                                ![username] = strUserID
                                '![FormName] = Screen.ActiveForm.Name
                                ![FormName] = f.Name
                                ![action] = UserAction
                                '![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                                ![recordid] = f.Controls(IDField).Value
                                ![fieldName] = ctl.ControlSource
                                ![OldValue] = ctl.OldValue
                                ![newValue] = ctl.Value
                                .Update
                            End With
                        End If
                    End If
                End If
            Next ctl
        Case Else
            With rst
                .AddNew
                ![DateTime] = datTimeCheck
                ![username] = strUserID
                '![FormName] = Screen.ActiveForm.Name
                ![FormName] = f.Name
                ![action] = UserAction
                '![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                ![recordid] = f.Controls(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
you pass the form as the third argument:

AuditChanges "ID", "Edit", Me
Click to expand...

Just to clarify,

Do you mean I have to change
Code: 
Private Sub Form_BeforeUpdate(cancel As Integer)
     Call AuditChanges("ID")
 End Sub
to

Code: 
Private Sub Form_BeforeUpdate(cancel As Integer)
     Call AuditChanges("ID","Edit", Me)
 End Sub
If I got it correct, changes were still not recorded
 
Last edited:
you trigger it in the subform's BeforeUpdate event
 
Hi,

I had similar problems with the audit code. I'm not sure if Screen.ActiveForm.ActiveControl.Form returns the correct value.
My solution was this:
Code: 
 Set frm = Screen.ActiveForm
 For Each ctl In frm![SubFormName].Controls
You could swap the hard coded Name of the subform with a variable so you can use it in every form.
 
daikaio94 said:
Hi,

I had similar problems with the audit code. I'm not sure if Screen.ActiveForm.ActiveControl.Form returns the correct value.
My solution was this:
Code: 
 Set frm = Screen.ActiveForm
 For Each ctl In frm![SubFormName].Controls
You could swap the hard coded Name of the subform with a variable so you can use it in every form.
Click to expand...

I tried, but it doesn't work.

What's actually in the subform (frmData) is a preview of tblDataSheet (as the control source) shown as table in a subform and I'm directly doing changes in the table.
 
Last edited:
Well, if the subform is opened in table view I don't think this is going to work. You're only going through all controlls with this routine and in table view there are no controlls.

I'm not sure if there is a solution for auditing changes that are made directly to a table but the code you are using is designed to work with bound controlls in a form.

Edit: If you want to look at an example you can check the example database I uploaded here: http://www.access-programmers.co.uk/forums/showpost.php?p=1499933&postcount=43
 
daikaio94,

I tried the database you posted
Edit: If you want to look at an example you can check the example database I uploaded here: http://www.access-programmers.co.uk/...3&postcount=43
Click to expand...
and received an error as shown in the attached jpg.

It would be helpful to others if you would include some instructions to reproduce and error or to show that
your set up solves a particular problem.

I did get an error, but in trying to help another poster with Martin Green's
audit trail and the issue with subforms, I'm not following what your
code/database was supposed to do. My understanding of your related
post was that you have a solution to the subform issue.
 

Attachments

  • subformuserError.jpg
    subformuserError.jpg
    65.5 KB · Views: 374
You must log in or register to reply here.

Similar threads

B
Solved AuditChanges not capturing ID for NEW additions
Replies
5
Views
1,200
theDBguy
theDBguy
T
Audit Trail - Tabbed Control
Replies
2
Views
1,195
jdraw
jdraw
mike60smart
Audit Trail
Replies
19
Views
2,977
jdraw
jdraw
RickHunter84
Getting Error 91 on Audit trail
Replies
7
Views
1,457
Minty
Minty
E
Module - Audit Trail: Read Only Error
2
Replies
20
Views
2,675
theDBguy
theDBguy

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom