Audit Trail, Tracking Changes (1 Viewer)

nhtuan

New member
Local time
Today, 02:36
Joined
Dec 23, 2010
Messages
24
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.
 

Users who are viewing this thread

Top Bottom