First, you will add three objects to your database:
1. A VBA module with Windows API calls to identify the user and PC name. This code has been tested with Windows 2000, XP and Vista 32-bit editions.
Attribute VB_Name =
"A70714 Win32 API calls"
Option Compare
Database
Option Explicit
Declare Function
GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function
GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function CompName()
'
returns: machine name, e.g.:
' MONORAILPC
Dim s As String,
n As Long
n = 255
s = Space(255)
If
GetComputerName(s, n) > 0 Then
CompName = Left(s, n)
End If
End Function
Function UserName()
'
returns: user name, e.g.:
' William Mitchell
Dim s As String,
n As Long
n = 255
s = Space(255)
If
GetUserName(s, n) > 0 Then
UserName = Left(s, n)
End If
End Function
Attribute VB_Name = "A70714
track changes"
Option Compare Database
Option Explicit
Sub TrackChanges(F
As Form)
Dim ctl As Control, frm As
Form
Dim MyField
As String, MyKey As Long, MyTable As String
Dim db As DAO.Database, rs As
DAO.Recordset
On Error Resume Next
Set frm = F
Set db =
CurrentDb
Set rs = db.OpenRecordset("tbl__ChangeTracker")
With frm
MyTable = .Tag
' find the primary
key & its value, based on the Tag
For Each ctl In
.Controls
If ctl.Tag =
"PK" Then
MyField = ctl.Name
MyKey = ctl
Exit
For
End
If
Next
ctl
For Each ctl In
.Controls
' inspect only
data-bound controls
Select
Case ctl.ControlType
Case
acTextBox, acComboBox, acCheckBox
If
Nz(ctl.ControlSource, "") > "" Then
' if changed,
record both old & new values
If Nz(ctl.OldValue, "")
<> Nz(ctl, "") Then
rs.AddNew
rs!FormName
= .Name
rs!MyTable
= MyTable
rs!MyField
= MyField
rs!MyKey
= MyKey
rs!ChangedOn
= Now()
rs!FieldName
= ctl.Name
If ctl.ControlType = acCheckBox Then
rs!Field_OldValue = YesOrNo(ctl.OldValue)
rs!Field_NewValue = YesOrNo(ctl)
Else
rs!Field_OldValue = Left(Nz(ctl.OldValue, ""),
255)
rs!Field_NewValue = Left(Nz(ctl, ""), 255)
End If
rs!UserChanged
= UserName()
rs!CompChanged
= CompName()
rs.Update
End If
End
If
End
Select
Next
ctl
End With
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
Private Function
YesOrNo(v) As String
Select Case v
Case -1
YesOrNo = "Yes"
Case 0
YesOrNo = "No"
End Select
End Function
Here is a VBA module that will create the table for you.
Option Compare Database
Option Explicit
Sub Create_tbl__ChangeTracker()
Dim db As DAO.Database
Dim fld As DAO.Field
Dim idx As DAO.Index
Dim tdf As DAO.TableDef
'
Set db =
CurrentDb
Set tdf = db.CreateTableDef("tbl__ChangeTracker")
With tdf
' ID is AutoNumber
and Primary Key
Set fld
= .CreateField("ID", dbLong)
fld.Attributes = dbAutoIncrField
.Fields.Append fld
Set idx
= .CreateIndex("ID")
idx.Fields = "ID"
idx.Primary = True
.Indexes.Append idx
'
' add remaining
fields
Set fld
= .CreateField("FormName", dbText, 64)
.Fields.Append fld
Set fld
= .CreateField("MyTable", dbText, 64)
.Fields.Append fld
Set fld
= .CreateField("MyField", dbText, 64)
.Fields.Append fld
Set fld
= .CreateField("MyKey", dbText, 64)
.Fields.Append fld
Set fld
= .CreateField("ChangedOn", dbDate)
.Fields.Append fld
Set fld
= .CreateField("FieldName", dbText, 64)
.Fields.Append fld
Set fld
= .CreateField("Field_OldValue", dbText,
255)
.Fields.Append fld
Set fld
= .CreateField("Field_NewValue", dbText, 255)
.Fields.Append fld
Set fld
= .CreateField("UserChanged", dbText, 128)
.Fields.Append fld
Set fld
= .CreateField("CompChanged", dbText, 128)
.Fields.Append fld
End With
db.TableDefs.Append
tdf
Set idx = Nothing
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
End Sub
1. Set the Tag property for the form = the name of the underlying table.
2. Identify the primary key for the data behind the form, and set the Tag property = "PK" (without the quotes). The field does not have to be visible on the form, it just needs to be there somewhere.
3. Add the Form_BeforeUpdate event and invoke the tracking code using:
TrackChanges Me
4. If you are using subforms, you'll need to perform these three steps for each subform as well.