Modifying Access VBA to capture changes made in forms

Question

I found this code on-line(http://www.fontstuff.com/access/acctut21.htm) to capture changes made to tables. The code works on the example database that was provided, but does not work on my database. For both the example and my database, changes are made through forms and triggered by an event procedure in the form properties at "Before Update". I do not get any errors, but nothing is written to the audit table. One difference between my form and that in the example is my form pulls data from multiple tables through a query, and updates are done to multiple tables. The example form is only showing fields from one table and updates are done only to one table.

How can I get this code to record my changes?

Option Compare Database
Option Explicit
Sub AuditChanges(IDField 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")
    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.NAME
                    ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                    ![FieldName] = ctl.ControlSource
                    ![OldValue] = ctl.OldValue
                    ![NewValue] = ctl.Value
                    .Update
                End With
            End If
        End If
    Next ctl
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

Answer 1

This is the code I use to create an audit log. It works well and can assign ItemTypes to the log entries. This is useful for viewing individual entries relating to a specific itemtype (such as Order, Customer, StockItem etc).

It is called by:

Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error Resume Next
AuditLog Me, "Order", Me.ID
End Sub

Function Code

Public Sub AuditLog(frm As Form, ItemType As String, ItemID As Integer, Optional exControl As Variant)
Dim ctl As Control
Dim varBefore As Variant
Dim varAfter As Variant
Dim strControlName As String
Dim strSql As String
On Error Resume Next

For Each ctl In frm.Controls
With ctl
'Avoid labels and other controls with Value property.
If .ControlType = acTextBox Or acComboBox Or acCheckBox Then
If .Tag = 1 Then

Else
If IsOldValueAvailable(ctl) = True Then
    If Nz(.Value, "[Empty]") <> Nz(.OldValue, "[Empty]") Then
    varBefore = .OldValue
    varAfter = .Value
    strControlName = .Name
    strSql = "INSERT INTO [UserActivities] (UserID,Entry,[Field],OldValue,NewValue,Type,ItemID) " & _
    "Values ('" & userid & "','Value Change','" & strControlName & "','" & varBefore & "','" & varAfter & "','" & ItemType & "','" & ItemID & "');"

    CurrentDb.Execute strSql, dbFailOnError

 End If
    End If
    End If
End If
End With
Next
Set ctl = Nothing
Exit Sub

ErrHandler:
MsgBox err.Description & vbNewLine _
& err.Number, vbOKOnly, "Error"
End Sub

Answer 2

This question is basically the same as this other StackOverflow answer. I based our solution off the one in the link using parameters, and altered it to an ADO command instead. Using parameters and an ADO command allows you to exceed the 255 character limit with DAO parameters, and if you end up trying to track an RTF field, you won't have the headache of trying to parse HTML/markdown/whatever into a safe SQL String (and is also more resistant to SQL injection attacks if users enter such data into your form). You'll find I used a "longText" field for our old/new values as this facilitates using memo fields and a more reusable field.

Using an ADO command vs recordset is orders of magnitude faster when logging field changes, as you don't need to do anything except insert to the data.

Note the following:

1. This solution requires linked tables and fields. It does not handle detection for non-linked fields.
2. This solution ignores getting user details (username) in a safe manner. Using the Environ variable isn't super secure, but I left it.
3. I found caching the command for later makes the command run an order of magnitude faster vs building it each time. When you're logging all fields on a form routinely (eg, for auditing), this makes a big difference at not a lot of cost to memory or connections.
4. I assumed all the fields were "text". That's probably not the case, so you'll need to change your field types to match the correct types and sizes.

The Code:

Option Compare Database
Option Explicit

Private m_strUserID as String
Private m_StoredCMD as ADODB.Command

Private Property Get StrUserID as String
    If m_struserID = vbNullString then m_strUserID = Environ("USERNAME")
    StrUserID = m_struserID
End Property

Public Sub AuditChanges(ByRef FormToProcess as Access.Form, Byref RecordIDField as String)
    Dim TimeStamp as DateTime
    Dim CtrlCheck as Access.Control
    Dim RecordIDFieldCtrl as Access.Control
    Set RecordIDFieldCtrl = FormToProcess.Controls(RecordIDField)
    TimeStamp = Now()
    For Each CtrlCheck In FormToProcess
        If IsChanged(CtrlCheck) And CtrlCheck.Tag = "Audit" Then
            AddLogEntry (CtrlChanged, RecordIDFieldCtrl.Value)
        End If
    Next CtrlCheck
End Sub

Private Sub AddLogEntry (ByRef CtrlChanged as Control, ByRef RecordIDFieldCtrl as Access.Control)
    Dim TimeStamp as DateTime
    Dim adoCMD =  ADODB.Command
    TimeStamp = Now()
    If IsChanged(CtrlChanged) Then    ' Verify anything actually changed. Check twice because it doesn't cost anything.
        Set adoCMD = GetLogCommand ' Note, it will be much faster to put this into a module stored command, but 
        With If adoCMD 
            (.ActiveConnection.State And adStateOpen) <> adStateOpen Then .ActiveConnection.Open
            .Parameters("[pDateTime]") = TimeStamp
            .Parameters("[pUserName]") = StrUserID
            .Parameters("[pFormName]") = CtrlChanged.Parent.Name
            .Parameters("[pRecordID]") = RecordIDFieldCtrl.Value
            .Parameters("[pFieldName]") = CtrlChanged.Name
            .Parameters("[pNewValue]") = CtrlChanged.Value
            .Parameters("[pOldValue]") = CtrlChanged.OldValue
            .Execute
    End If
End Sub

Public Function GetLogCommand() As ADODB.Command
    Dim cnn as ADODB.Connection
    Dim SQLCommand as String

    If m_StoredCMD Is Nothing Then 
        ' Note: Verify these field type assumptions are correct and alter as needed.
        ' Note2: I use "LongText" Fields for values, because Access's VarChar Fields are limited to 255 charachters. 
        '        If you're using any
        SQLCommand = "PARAMETERS [pDateTime] DateTime, [pUserName] VARCHAR(255), " & _ 
                    "[pFormName] VARCHAR(255), [pRecordID] VARCHAR(255), [pFieldName] VARCHAR(255)," & _ 
                    "[pOldValue] LONGTEXT, [pNewValue] LONGTEXT;
                    INSERT INTO tblAuditTrail (DateTime,UserName,FormName,RecordID,FieldName,OldValue,NewValue) " & _ 
                    "VALUES ([pDateTime], [pUserName], [pFormName], [pRecordID], [pFieldName], [pOldValue], [pNewValue]); "
        Set m_StoredCMD = New ADODB.Command
        With m_StoredCMD
            Set .ActiveConnection = CurrentProject.Connection
            .CommandText = SQLString.GetStr
            .CommandType = adCmdText
            .Prepared = True
            .Parameters.Append .CreateParameter("[pDateTime]", adDBTimeStamp, adParamInput, 255)
            .Parameters.Append .CreateParameter("[pUserName]", adVarChar, adParamInput, 255)
            .Parameters.Append .CreateParameter("[pFormName]", adVarChar, adParamInput, 255)
            .Parameters.Append .CreateParameter("[pRecordID]", adVarChar, adParamInput, 255)
            .Parameters.Append .CreateParameter("[pFieldName]", adVarChar, adParamInput, 255)
            .Parameters.Append .CreateParameter("[pNewValue]", adLongVarChar, adParamInput, 63999)
            .Parameters.Append .CreateParameter("[pOldValue]", adLongVarChar, adParamInput, 63999)
        End With
    End If

    Set GetLogCommand = m_StoredCMD
End Function

Public Function IsChanged(ByRef CtrlChanged as Control) As Boolean
    ' There are a lot of ways to do this, but this keeps code clutter down, and lets you 
    ' alter how you determine if a control was altered or not.
    ' As this is written, it will ONLY work on bound controls in bound forms.
    IsChanged = ((CtrlChanged.OldValue <> CtrlChanged.Value) Or (IsNull(CtrlChanged.OldValue) = Not IsNull(CtrlChanged.Value)))
End Function