Public Function AuditData()
' Comments : This function is used to provide an audit trail of all changes to a record
' : entered on a secured form. After adding a locked memo field called 'Updates'
' : on the source form, add a reference to the Before Update event to this function.
' Requirement: A bound memo field named 'Updates' must exist on the active form
' Parameters : None
' Returns : Appends Audit Trail data as a string to the memo field on the active form
' Created By : Ofni Systems Inc.
' Modified : 04/07/01
' --------------------------------------------------------
Dim frmActive As Form
Dim ctlData As Control
Dim strEntry As String
Set frmActive = Screen.ActiveForm
'Determine who, when and where
strEntry = " by " & Application.CurrentUser & " on " & Now
' If new record, record it in audit trail and exit sub
If frmActive.NewRecord = True Then
frmActive!Updates = frmActive!Updates & "New Record Added" & strEntry
'Uncomment the next line if you do not want to record the details of the initial entry
'Exit Function
End If
'Check each data entry control for change and record
For Each ctlData In frmActive.Controls
' Only check data entry type controls
Select Case ctlData.ControlType
Case acTextBox, acComboBox, acCheckBox, acOptionButton
' Skip Updates field
If ctlData.Name = "Updates" Then GoTo NextCtl
'Skip unbound controls (3 is ControlSource)
If ctlData.Properties(3) = "" Then GoTo NextCtl
Select Case IsNull(ctlData.Value)
'Check for deleted data
Case True
If Not IsNull(ctlData.OldValue) Then
frmActive!Updates = frmActive!Updates & Chr(13) & Chr(10) & " " & ctlData.Name & " Data Deleted: Old value was '" & ctlData.OldValue & "'" & strEntry
End If
'Check for new or changed data
Case False
If IsNull(ctlData.OldValue) And Not IsNull(ctlData.Value) Then
frmActive!Updates = frmActive!Updates & Chr(13) & Chr(10) & " " & ctlData.Name & " Data Added: " & ctlData.Value & strEntry
'If control had previous value, record previous value
ElseIf ctlData.Value <> ctlData.OldValue Then
frmActive!Updates = frmActive!Updates & Chr(13) & Chr(10) & " " & ctlData.Name & " changed from '" & ctlData.OldValue & "' to '" & ctlData.Value & "'" & strEntry
End If
End Select
End Select
NextCtl:
Next ctlData
End Function