AuditTrail Tracking Problem, Access 2010

[ssanfu]

You're welcome. Good luck with the VBA class and keep learning....

I still learn new things in programming.

[johngachui]

This is my solution based on the one by Martin Green at http://www.fontstuff.com/access/acctut21.htm

I have changed things to
1. Save additions the same way as edits
2. To save old and new values in memo fields as concantenated strings of "[fieldname1]:[value1];.....[fieldname(n)]:[value(n)]"
3. To save ID of deleted record correctly (the original solution seemed to have a problem)
4. Gets combo displayed text instead of bound column (unless they are the same!)
5. Includes reference to fOSMachineName() code from Dev Ashish for computer name

Modified code: (See Green's solution for full explanation)
Sub AuditChanges(IDField As String, UserAction As String, Optional DeletedID As String)
'On Error GoTo AuditChanges_Err

Dim rst As Recordset
Dim ctl As control
Dim datTimeCheck As Date
Dim strUserID As String
Dim prp As Property
Dim updatectl As Boolean
Dim OldStr As String, NewStr As String
Dim colx As Integer, colwidth As String, lenx As Integer, str As String, valx As Integer, visiblecol As Boolean
Dim i As Long, OldID, NewID

Set rst = CurrentDb.OpenRecordset("Audit")

datTimeCheck = Now()
strUserID = fOSMachineName()
Select Case UserAction
Case "DELETE"
With rst
.AddNew
![DateTime] = datTimeCheck
![Username] = strUserID
![FormName] = Screen.ActiveForm.Name
![Action] = UserAction
![RecordID] = DeletedID
.Update
End With
Case Else
OldStr = ""
NewStr = ""
For Each ctl In Screen.ActiveForm.Controls
updatectl = False
For Each prp In ctl.Properties
If prp.Name = "Controlsource" Then
If IsNull(ctl.ControlSource) = False Then updatectl = True
End If
Next prp

If ctl.ControlType = acComboBox Then
colx = 0
visiblecol = False
colwidth = ctl.ColumnWidths
lenx = Len(colwidth)

For i = 1 To lenx
str = Mid(colwidth, i, 1)
If visiblecol = False Then
If IsNumeric(str) = True Then
valx = Val(str)
If valx > 0 Then visiblecol = True
Else
If str = ";" Then colx = colx + 1
End If
End If
Next i

End If

If updatectl = True Then
If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
If OldStr > "" Then
OldStr = OldStr & " ; "
NewStr = NewStr & " ; "
End If
If ctl.ControlType = acComboBox Then
For i = 0 To (ctl.ListCount - 1)
If Trim(ctl.Column(ctl.BoundColumn - 1, i)) = Trim(ctl.OldValue) Then
OldStr = OldStr & ctl.ControlSource & " : " & ctl.Column(colx, i)
End If
Next i

NewStr = NewStr & ctl.ControlSource & " : " & ctl.Column(colx)
Else
OldStr = OldStr & ctl.ControlSource & " : " & ctl.OldValue
NewStr = NewStr & ctl.ControlSource & " : " & ctl.Value
End If
End If
End If
Next ctl
If UserAction = "NEW" Then OldStr = ""
With rst
.AddNew
![DateTime] = datTimeCheck
![Username] = strUserID
![FormName] = Screen.ActiveForm.Name
![Action] = UserAction
![RecordID] = Screen.ActiveForm.Controls(IDField).Value
![OldValue] = OldStr
![NewValue] = NewStr
.Update
End With

End Select
AuditChanges_Exit:
On Error Resume Next
rst.Close
Set rst = Nothing
Exit Sub
AuditChanges_Err:
MsgBox Err.Description, vbCritical, "ERROR!"
Resume AuditChanges_Exit
End Sub

Call from each form with:
assumption is your PK id called ID

Dim DelID As String

Private Sub Form_BeforeUpdate(Cancel As Integer)
If Me.NewRecord Then
Call AuditChanges("ID", "NEW")
Else
Call AuditChanges("ID", "EDIT")
End If
End Sub

Private Sub Form_Delete(Cancel As Integer)
DelID = [ID]
End Sub

Private Sub Form_AfterDelConfirm(Status As Integer)
If Status = acDeleteOK Then Call AuditChanges("ID", "DELETE", DelID)
End Sub