Sub AuditChanges(IDField As String)
10 On Error GoTo AuditChanges_Error 'jed
' Dim cnn As ADODB.Connection 'jed
' Dim rst As ADODB.Recordset 'jed
Dim db As dao.Database 'jed
Dim rst As dao.Recordset 'jed
Dim ctl As Control
Dim datTimeCheck As Date
Dim strUserID As String
' Set cnn = CurrentProject.Connection 'jed
' Set rst = New ADODB.Recordset 'jed
20 Set db = CurrentDb 'jed
30 Set rst = db.OpenRecordset("tblaudittrail") 'jed
' rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic 'jed
40 datTimeCheck = Now()
50 strUserID = Environ("USERNAME")
60 For Each ctl In Screen.ActiveForm.Controls
70 If ctl.Tag = "Audit" Then
80 If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
90 With rst
100 .AddNew
110 ![DateTime] = datTimeCheck
120 ![UserName] = strUserID
130 ![FormName] = Screen.ActiveForm.Name
140 ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
150 ![FieldName] = ctl.ControlSource
160 ![OldValue] = ctl.OldValue
170 ![NewValue] = ctl.Value
180 .Update
190 End With
200 End If
210 End If
220 Next ctl
230
AuditChanges_Exit:
240 On Error Resume Next
250 rst.Close
' cnn.Close 'jed
260 Set rst = Nothing
' Set cnn = Nothing 'jed
270 Exit Sub
AuditChanges_Err:
280 MsgBox Err.Description, vbCritical, "ERROR!"
290 Resume AuditChanges_Exit
300 On Error GoTo 0
310 Exit Sub
AuditChanges_Error: ' I added this and line numbers to go with my Error handler (MZTools for VBA)
320 MsgBox "Error " & Err.Number & " in line " & Erl & " (" & Err.Description & ") in procedure AuditChanges of Module basAudit"
End Sub