Modifying Access VBA to capture changes made in forms - ms-access

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:
This solution requires linked tables and fields. It does not handle detection for non-linked fields.
This solution ignores getting user details (username) in a safe manner. Using the Environ variable isn't super secure, but I left it.
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.
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