Mark:
Thanks for the post.
This example is similar to one I created from the same MS Knowledge Base article.
I took it a step further, though, and created it as a module which captures the form and control name and the old and new values and writes an entry to a separate audit log table. The module is called from the form's Before Update event.
I have it working pretty well except that it will sometimes choke on combo boxes. Haven't quite figured it out yet since the problem is sporadic and not, so far, reproducable.
The good news for HIPAA security is that this piece is not required until next year. Gives us a bit more time to procrastinate.
For anyone interested, here is the module I have:
'This procedure is used to provide an audit trail of all changes to a record entered
'in the Incident Report Database.
'All changes (add record, change record, delete record) are recorded in tblAudit
'Creation Date : 09/19/02
'Last Mod Date :
'Created by : Larry De Laruelle
'
Option Compare Database
Option Explicit
Public Sub AuditData(RecordID)
Dim frmActive As Form
Dim ctlData As Control
Dim dbTemp As Database
Dim rsTemp As Recordset
On Err GoTo NextCtl
Set dbTemp = CurrentDb
Set rsTemp = dbTemp.OpenRecordset("tblAudit"
Set frmActive = Screen.ActiveForm
If frmActive.NewRecord = True Then 'Tests for New Record. If true then
With rsTemp 'an audit record is created reflecting
.AddNew 'that fact and identifying the new
!FormName = frmActive.Name 'record's record ID
!RecNum = RecordID
!AuditStatus = "New Record"
!AuditDate = Date
!AuditUser = [CurrentUser]
.Update
End With
Else
For Each ctlData In frmActive.Controls
Select Case ctlData.ControlType
Case acTextBox, acComboBox, acCheckBox, acOptionButton
If ctlData.Name = "Updates" Then GoTo NextCtl
'Debug.Print "ctlData.Name: " & ctlData.Name
If ctlData.Properties(3) = "" Then GoTo NextCtl
'Debug.Print "ctlData.Properties(3): " & ctlData.Properties(3)
Select Case IsNull(ctlData.Value)
'Identifies deleted information
Case True
If Not IsNull(ctlData.OldValue) Then 'Original value was deleted
With rsTemp
.AddNew
!FormName = frmActive.Name
!FieldName = ctlData.Name
!RecNum = RecordID
!AuditStatus = "Deleted Data"
!OldValue = ctlData.OldValue
!AuditDate = Date
!AuditUser = [CurrentUser]
.Update
End With
End If
'Identifies changed information
Case False
If IsNull(ctlData.OldValue) And Not IsNull(ctlData.Value) Then 'A new value has been added
With rsTemp
.AddNew
!FormName = frmActive.Name
!FieldName = ctlData.Name
!RecNum = RecordID
!AuditStatus = "Data Added"
!OldValue = "Was Empty"
!NewValue = ctlData.Value
!AuditDate = Date
!AuditUser = [CurrentUser]
.Update
End With
ElseIf ctlData.Value <> ctlData.OldValue Then 'Data was changed
With rsTemp
.AddNew
!FormName = frmActive.Name
!FieldName = ctlData.Name
!RecNum = RecordID
!AuditStatus = "Value Revised"
!OldValue = ctlData.OldValue
!NewValue = ctlData.Value
!AuditDate = Date
!AuditUser = [CurrentUser]
.Update
End With
End If
End Select
End Select
Next ctlData
End If
rsTemp.Close
Set dbTemp = Nothing
Exit_Sub:
Exit Sub
NextCtl:
'Next ctlData
End Sub
Larry De Laruelle
ldelaruelle@familychildrenscenter.org
