I didn't write this but it works; it needs a table to store the log:
==========================================================
Option Compare Database 'Use database order for string comparisons
Option Explicit
Const ahtcLogAdd = 1
Const ahtcLogUpdate = 2
Const ahtcLogDelete = 3
Function ahtLog(strTableName As String, varPK As Variant, intAction As Integer) As Integer
' Log a user action in the log table
On Error GoTo ahtLog_Err
Dim db As Database
Dim rstLog As Recordset
Set db = CurrentDb()
Set rstLog = db.OpenRecordset("ChangeLogging", dbOpenDynaset, dbAppendOnly)
With rstLog
.AddNew
![UserName] = fUserNTIdent 'modules to get the ID are readily available. Let me know if you cannot find one.
![TableName] = strTableName
![RecordPK] = varPK
![ActionDate] = Now
![Action] = intAction
rstLog.Update
End With
rstLog.Close
ahtLog = True
ahtLog_Exit:
On Error GoTo 0
Exit Function
ahtLog_Err:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "ahtLog()"
ahtLog = False
Resume ahtLog_Exit
End Function
Function ahtLogAdd(strTableName As String, varPK As Variant) As Integer
' Record addition of a new record in the
' log table
On Error GoTo ahtLogAdd_Err
ahtLogAdd = ahtLog(strTableName, varPK, ahtcLogAdd)
ahtLogAdd_Exit:
On Error GoTo 0
Exit Function
ahtLogAdd_Err:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "ahtLogAdd()"
Resume ahtLogAdd_Exit
End Function
Function ahtLogDelete(strTableName As String, varPK As Variant) As Integer
' Record deletion of a record in the
' log table
On Error GoTo ahtLogDelete_Err
ahtLogDelete = ahtLog(strTableName, varPK, ahtcLogDelete)
ahtLogDelete_Exit:
On Error GoTo 0
Exit Function
ahtLogDelete_Err:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "ahtLogDelete()"
Resume ahtLogDelete_Exit
End Function
Function ahtLogUpdate(strTableName As String, varPK As Variant) As Integer
' Record updating of a record in the
' log table
On Error GoTo ahtLogUpdate_Err
ahtLogUpdate = ahtLog(strTableName, varPK, ahtcLogUpdate)
ahtLogUpdate_Exit:
On Error GoTo 0
Exit Function
ahtLogUpdate_Err:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "ahtLogUpdate()"
Resume ahtLogUpdate_Exit
End Function
==========================================================
Enjoy - Joe McDonnell