Go Back   Access World Forums > Microsoft Access Discussion > Modules & VBA

 
Reply
 
Thread Tools Rate Thread Display Modes
Old 06-13-2019, 12:20 AM   #1
nhtuan
Newly Registered User
 
Join Date: Dec 2010
Posts: 9
Thanks: 0
Thanked 0 Times in 0 Posts
nhtuan is on a distinguished road
Audit Trail, Tracking Changes

Solution for one who needs with simple code and applying into access database to track for all changes and adding new records or deleting records from main form and subform. If we need to record any change that happens to any record from a main form that links to a subform by one-to-many relationship. Both changes happen from main from and subform will be also recorded. Theory is to create a table that stores all changes done by User "computername" and date when it happen, and on form where data have been changed, in addition the second, minute, and date also recorded in primary key and when creating Key for the recording table.

Details instruction on step by step implementation:

For the mainform:

Step 1. Creating table to keep all changes

The table contains following fields

Table name: canregnotes
Variable contained in "canregnotes":
msbenhnhan: Primary key of the record to be tracked
tenbien: Name of the variable to be recorded
myoldval: Old value is the value before the change
mynewval: New value: value after change
chngdate: the date of change
madeby: The computer name that used to change
onfrmName: The form where changed happened

Step 2. Create a module that contains this following Function for mainform

Code:
Public Function DTrackChanges()
     
    Dim ActiveForm As Form
    Dim Actrl As Control
    Dim UserId As String
    
    'Dim ActivSubForm As Form
    'Set ActivSubForm = Screen.ActiveControl.Parent
' Then to use that pointer to get the name
    'MsgBox ActivSubForm.Name
    'Dim sbfrmName As String
    'sbfrmName = "canregsub"
    
    Dim frmName As String
    Set ActiveForm = Screen.ActiveForm
    frmName = ActiveForm.Name
    
    UserId = Environ$("computername")
    
    If ActiveForm.NewRecord = True Then
        CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Forms(frmName)!identry.Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & "New Record" & "','" & "New Record" & "', '" & "New Record added on " & Now & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserId & "', '" & frmName & "')"
        DoCmd.SetWarnings False
        Exit Function
    End If
   
    For Each Actrl In ActiveForm.Controls
    
    Select Case Actrl.ControlType
    Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
        If Actrl.Value <> Actrl.OldValue Then
                CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Forms(frmName)!identry.Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & Actrl.Name & "' ,'" & Actrl.OldValue & "', '" & Actrl.Value & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserId & "', '" & frmName & "')"
                DoCmd.SetWarnings False
                
            ElseIf IsNull(Actrl.OldValue) And Len(Actrl.Value) > 0 Or Actrl.OldValue = "" And Len(Actrl.Value) > 0 Then
                CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Forms(frmName)!identry.Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & Actrl.Name & "' ,'" & "Null" & "', '" & Actrl.Value & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserId & "', '" & frmName & "')"
                DoCmd.SetWarnings False
            ElseIf IsNull(Actrl.Value) And Len(Actrl.OldValue) > 0 Or Actrl.Value = "" And Len(Actrl.OldValue) > 0 Then
                CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Forms(frmName)!identry.Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & Actrl.Name & "' ,'" & Actrl.OldValue & "', '" & "Null" & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserId & "', '" & frmName & "')"
                DoCmd.SetWarnings False
            End If
        
    End Select
    
TryNextControl:
    Next Actrl
    

Exit_DTrackChanges:
    Exit Function
    
End Function
Step 3. Call the function on Before Update event

Code:
Private Sub Form_BeforeUpdate(Cancel As Integer)
    
Call DTrackChanges

End Sub
For the subform

Step 1. Copy and past the following code to VBA open from the subform

Code:
Sub SubDTrackChanges()
     
    Dim ActiveSubForm As Form
    Dim Actrlsub As Control
    Dim UserIdsub As String
    
    'Dim ActivSubForm As Form
    'Set ActivSubForm = Screen.ActiveControl.Parent
' Then to use that pointer to get the name
    'MsgBox ActivSubForm.Name
    'Dim sbfrmName As String
    'sbfrmName = "canregsub"
    
    'Dim frmName As String
    Set ActiveSubForm = Screen.ActiveControl.Parent.Form
    'frmName = ActiveSubForm.Name
    
    UserIdsub = Environ$("computername")
    
    If ActiveSubForm.NewRecord = True Then
        CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Screen.ActiveControl.Parent.Form.Controls("identry").Value & Screen.ActiveControl.Parent.Form.Controls("dtpmkey").Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & "New Record" & "','" & "New Record" & "', '" & "New Record added on " & Now & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserIdsub & "', '" & Screen.ActiveControl.Parent.Form.Name & "')"
        DoCmd.SetWarnings False
        Exit Sub
    End If
   
    For Each Actrlsub In ActiveSubForm.Controls
    
    Select Case Actrlsub.ControlType
    Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
        If Actrlsub.Value <> Actrlsub.OldValue Then
                CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Screen.ActiveControl.Parent.Form.Controls("identry").Value & Screen.ActiveControl.Parent.Form.Controls("dtpmkey").Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & Actrlsub.Name & "' ,'" & Actrlsub.OldValue & "', '" & Actrlsub.Value & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserIdsub & "', '" & Screen.ActiveControl.Parent.Form.Name & "')"
                DoCmd.SetWarnings False
                
            ElseIf IsNull(Actrlsub.OldValue) And Len(Actrlsub.Value) > 0 Or Actrlsub.OldValue = "" And Len(Actrlsub.Value) > 0 Then
                CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Screen.ActiveControl.Parent.Form.Controls("identry").Value & Screen.ActiveControl.Parent.Form.Controls("dtpmkey").Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & Actrlsub.Name & "' ,'" & "Null" & "', '" & Actrlsub.Value & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserIdsub & "', '" & Screen.ActiveControl.Parent.Form.Name & "')"
                DoCmd.SetWarnings False
            ElseIf IsNull(Actrlsub.Value) And Len(Actrlsub.OldValue) > 0 Or Actrlsub.Value = "" And Len(Actrlsub.OldValue) > 0 Then
                CurrentDb.Execute "INSERT INTO canregnotes(msbenhnhan, tenbien, myoldval, mynewval, chngdate, madeby, onfrmName) VALUES ('" & Screen.ActiveControl.Parent.Form.Controls("identry").Value & Screen.ActiveControl.Parent.Form.Controls("dtpmkey").Value & Format(Now(), "hhmmssddmmyyyy") & Int((999 - 100 + 1) * Rnd + 100) & "','" & Actrlsub.Name & "' ,'" & Actrlsub.OldValue & "', '" & "Null" & "', '" & Format(Now(), "dd/mm/yyyy") & "', '" & "by " & UserIdsub & "', '" & Screen.ActiveControl.Parent.Form.Name & "')"
                DoCmd.SetWarnings False
            End If
        
    End Select
    
TryNextControl:
    Next Actrlsub
    

Exit_SubDTrackChanges:
    Exit Sub
    
End Sub
Step 2. Call the Sub on Before Update

Code:
Private Sub Form_BeforeUpdate(Cancel As Integer)
'On Error GoTo Form_BeforeUpdate_Err
    

Call SubDTrackChanges
'Form_BeforeUpdate_Exit:
'    Exit Sub
    
'Form_BeforeUpdate_Err:
'    MsgBox Err.Number & " - " & Err.Description
'    Resume Form_BeforeUpdate_Exit

End Sub
Save, Close and Reopen Form again, enjoy!.

Tuan.

nhtuan is offline   Reply With Quote
Reply

Tags
mainform , subform , tracking changes , vba

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Audit Trail libby32 General 290 06-20-2019 06:12 PM
audit trail bigmac Forms 58 05-31-2019 03:20 PM
audit trail slimjen1 Forms 10 10-13-2011 12:15 PM
Audit Trail into a separate table (Tracking record edits in a databse) irish634 Code Repository 0 09-25-2008 05:40 AM
Help with Audit Trail Gannet Modules & VBA 1 09-17-2008 07:22 AM




All times are GMT -8. The time now is 07:19 AM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Featured Forum post


Sponsored Links


Powered by vBulletin®
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World