Audit Trail into a separate table (Tracking record edits in a databse) (1 Viewer)

Option Compare Database
Option Explicit

Dim dbs As DAO.Database
Dim sAuditTable As String
Dim sSQL As String

Dim sTable As String        'Table where the record is being edited
Dim CTL As Control          'The control in the form being edited
Dim sFrom As String         'Original Data in the control
Dim sTo As String           'What the original data was changed to

Dim sPCName As String       'Name of the PC that is being used
Dim sPCUser As String       'Name of the User on the Networked PC
Dim sDBUser As String       'Name of the Database User
Dim sDateTime As String     'Date and Time of the change

'===========================================================================================
'
'   This Audit Trail will track changes to existing records.
'   In the "Before Update" event of the FORM enter the following:
'
'       Call AuditTrail(Me.Form, [RecordID])
'
'   Make sure to create a table called "tbl_AuditLog" and have the following fields:
'   (A table will be created automatically if it does not exist)
'
'       1. RecordID (This is a unique number)
'       2. txt_Table (This is the table where the record was changed)
'       3. lng_TblRecord (This is the RecordID number from the record being changed)
'       4. txt_Form (This is the form being used to edit the record)
'       5. txt_Control (This is the data entry control (field) that was edited
'       6. mem_From (This is the original data in the control (field)
'       7. mem_To (This is what the original data was changed to)
'       8. txt_PCName (This is the name of the PC used to edit the record)
'       9. txt_PCUser (This is the name of the user logged onto the PC)
'       10. txt_DBUser (This is the name of the person looged on to the databse if used)
'       11. dat_DateTime (This is the date and time the record was edited.)
'
'
'   The inspiration behind this code is from:
'       1. http://support.microsoft.com/default.aspx?scid=kb;en-us;197592
'       2. http://www.access-programmers.co.uk/forums/showthread.php?t=44231
'
'
'   Be sure to enable the "Microsoft DAO 3.6 Object Library" Reference
'
'============================================================================================
    


Public Function AuditTrail(frm As Form, lngRecord As Long)
On Error GoTo Error_Handler
    
    '----------------------------------------------------------------------
    '   Skips this procedure if a new record is being entered in the form
    '----------------------------------------------------------------------
    If frm.NewRecord = True Then
        Exit Function
    End If
        
    '----------------------------------------------------------------------
    '   Checks to see if the tbl_AuditLog Exists
    '   Creates the table if it does not exist
    '----------------------------------------------------------------------
    Set dbs = CurrentDb
    dbs.TableDefs.Refresh
    
    sAuditTable = "tbl_AuditLog"
    On Error Resume Next
    If IsNull(dbs.TableDefs(sAuditTable)) Then
        'Table does not exist
        On Error GoTo Error_Handler
        sSQL = "CREATE TABLE tbl_AuditLog([RecordID] COUNTER PRIMARY KEY, [txt_Table] TEXT(50), [lng_TblRecord] LONG, " & _
                "[txt_Form] TEXT(50), [txt_Control] TEXT(50), [mem_From] MEMO, [mem_To] MEMO, [txt_PCName] TEXT(50), " & _
                "[txt_PCUser] Text(50), [txt_DBUser] Text(50), [dat_DateTime] DATETIME);"
        DoCmd.SetWarnings False
        DoCmd.RunSQL sSQL
        DoCmd.SetWarnings True
    Else
        'Table Exists. Do Nothing
        On Error GoTo Error_Handler
        
    End If

    Set dbs = Nothing
       
     
       
    '----------------------------------------------------------------------
    '   Runs through each control on the form and checks for edits/changes
    '----------------------------------------------------------------------
    For Each CTL In frm
    
        Select Case CTL.ControlType     'Only checks data entry type controls.
            Case acTextBox, acComboBox, acListBox, acOptionGroup
                
                sFrom = Nz(CTL.OldValue, "Null")
                sTo = Nz(CTL.Value, "Null")
                
                If sFrom <> sTo Then
                
                    '-----------------------------------
                    '   Gets the required Info
                    '-----------------------------------
                    sTable = frm.RecordSource
                    sPCName = Environ("COMPUTERNAME")
                    sPCUser = Environ("Username")
                    sDBUser = "Me"      'Get Username from the database login
                    sDateTime = Now()

                    sSQL = "INSERT INTO tbl_AuditLog ([txt_Table], [lng_TblRecord], [txt_Form], [txt_Control], " & _
                           "[mem_From], [mem_To], [txt_PCName], [txt_PCUser], [txt_DBUser], [dat_DateTime]) " & _
                           "VALUES ('" & sTable & "', '" & lngRecord & "', '" & frm.Name & "', " & _
                           "'" & CTL.Name & "', '" & sFrom & "', '" & sTo & "', '" & sPCName & "', " & _
                           "'" & sPCUser & "', '" & sDBUser & "', '" & sDateTime & "')"
                    DoCmd.SetWarnings False
                    DoCmd.RunSQL sSQL
                    DoCmd.SetWarnings True
    
                End If
        End Select
    Next CTL
    
Error_Handler_Exit:
   Exit Function

Error_Handler:
    MsgBox ("Error No: " & Err.Number & vbCrLf & vbCrLf & "Error Description: " & Err.Description)
    Err.Clear
    Resume Error_Handler_Exit

End Function