Sorry the answer was so obvious and I totally missed it (I was
wondering why it worked on one form but not the other but then I
realised I was using a list box for the other form). Sorry my bad!
As for the code:
What the code does is, everytime a change is made on a form, the change
is recorded with details of the username and date recorded as well.
This information is then transferred into an audit table.
The following code captures the PK and passes into the Audit trail
function:
Private Sub Form_BeforeUpda te(Cancel As Integer)
'if Billing Element Details are edited, then capture Audit data
If Not IsNull(Me![Element ID]) And Me![Element ID] <"" Then
AuditTrail "Element Id", Me![Element ID],
Form_Subfrm_Bil ling_Single
End If
End Sub
Below is the Audit Trail function
Option Compare Database
Option Explicit
Public strConnectionSt ring As String
Public Sub AuditTrail(KeyF ieldName As String, KeyFieldValue As String,
MyForm As Form)
'Procedure Name - AuditTrail
'Description - This procedure captures the amendments done in
each and every fields of the Products, Hierarchy, Rules, Kenan, Seibel
tables
'Parameters - KeyFieldName - Name of the Key Field that
uniquely identifies the modified record
' - KeyFieldValue - Value of the Key Field that uniquely identifies
the modified record
' - MyForm - Form Object that holds the reference to the Form in
which the amendments are made
On Error GoTo Err_Handler
Dim objConn As New ADODB.Connectio n
Dim strSql As String
Dim c As Control, xName As String
strSql = ""
'Connection string for Product Definition Database
strConnectionSt ring = Application.Cur rentProject.Acc essConnection
'Set date and current user if form has been updated.
MyForm!Updates = MyForm!Updates & Chr(13) & Chr(10) & _
"Changes made on " & Date & " at - " & Time & " by " &
CurrentUser() & ";"
'If new record, record it in audit trail and exit sub.
If MyForm.NewRecor d = True Then
If Not IsNull(MyForm!U pdates) And MyForm!Updates <"" Then
'New Record is not yet captured in Audit
MyForm!Version = 1
Dim strAddition As String ' to capture Addition details
If Left(KeyFieldNa me, 7) = "Element" Then
If MyForm.Name = "SubFrm_Hierarc hy_Element" Then
'New Element Addition
strAddition = "New Element - " & KeyFieldValue & "
added for Product - " & MyForm![Product]
Else
Exit Sub
End If
Else
'New Product Addition
strAddition = "New Product - " & KeyFieldValue & "
added "
End If
MyForm!Updates = MyForm!Updates & Chr(13) & Chr(10) &
strAddition
'Inserting Audit Information for the New Record
objConn.Connect ionString = strConnectionSt ring
On Error GoTo DBAccess_Err
objConn.Open
strSql = "INSERT INTO TBL_AUDIT ([USER NAME], [CHANGE
DATE], [TABLE NAME]," _
& " [KEY FIELD NAME], [KEY FIELD VALUE], [FIELD
CHANGED],CHANGES)" _
& " Values ('" & CurrentUser() & "' ,#" _
& Format(Date, "dd-MMM-yyyy") & " " & Format(Time,
"hh:mm:ss AMPM") & "# , '" & MyForm.RecordSo urce & "' ,'" _
& KeyFieldName & "','" & KeyFieldValue & "','','" _
& strAddition & "')"
On Error GoTo QueryExecErr
objConn.Execute strSql
objConn.Close
End If
Else
'if record is Edited, capture Audit Trail Data
Dim strOldValue As String 'To store the Old Value of the form
control
Dim bolInsert As Boolean 'Boolean value to check whether the
Audit log need to be inserted or not
Dim intAuditCount As Integer
intAuditCount = 0
'Check each data entry control for change and record old value
of Control.
For Each c In MyForm.Controls
'Only check data entry type controls.
Select Case c.ControlType
Case acTextBox, acComboBox, acOptionGroup
bolInsert = False
strOldValue = ""
' Skip Updates field and Version Field
If c.Name <"Updates" And c.Name <"Version" Then
' If control was previously Null, record "previous
' value was blank."
If (IsNull(c.OldVa lue) Or c.OldValue = "") Then
'check if some value has been inserted in
the blank field
'if so, record it in Audit Trail
If (Not IsNull(c.value) Or c.value <"")
Then
MyForm!Updates = MyForm!Updates &
Chr(13) & _
Chr(10) & c.Name & " -- previous value
was blank"
strOldValue = "Blank "
bolInsert = True
End If
' If control had previous value, record
previous value.
' and it has been changed now, record it in
Audit Trail
ElseIf IIf(IsNull(c.va lue), "", c.value) <>
c.OldValue Then
strOldValue = c.OldValue
MyForm!Updates = MyForm!Updates & Chr(13) &
Chr(10) & _
c.Name & " == previous value was " &
c.OldValue
bolInsert = True
End If
If bolInsert = True Then
objConn.Connect ionString =
strConnectionSt ring
On Error GoTo DBAccess_Err
objConn.Open
'Inserting Change details in AuditTrail
table
strSql = "INSERT INTO TBL_AUDIT ([USER
NAME], [CHANGE DATE], [TABLE NAME]," _
& " [KEY FIELD NAME], [KEY FIELD VALUE],
[FIELD CHANGED],CHANGES)" _
& " Values ('" & CurrentUser() & "'
,#" _
& Format(Date, "dd-MMM-yyyy") & " "
& Format(Time, "hh:mm:ss AMPM") & "# , '" & MyForm.RecordSo urce & "'
,'" _
& KeyFieldName & "','" &
KeyFieldValue & "','" _
& c.Name & "' , '" & strOldValue &
" --" _
& c.value & "')"
On Error GoTo QueryExecErr
objConn.Execute strSql
objConn.Close
intAuditCount = intAuditCount + 1
End If
End If
End Select
Next c
If intAuditCount 0 Then
'Edit case, so increment the Version of the changes
MyForm!Version = MyForm!Version + 1
End If
End If
Set objConn = Nothing
TryNextC:
Exit Sub
DBAccess_Err:
MsgBox "Error Occured while Conencting to the Database." & vbCrLf &
Err.Description , vbCritical, "Audit Module"
Exit Sub
QueryExecErr:
MsgBox "Error occured while Inserting data in to Audit Trail" &
vbCrLf & Err.Description , vbCritical, "Audit Module"
Resume Next
Err_Handler:
If Err.Number <64535 Then
MsgBox "Error occured while caoturing Audit Data " & vbCrLf &
"Descriptio n: " & Err.Description , vbCritical, "Audit Module"
End If
Resume TryNextC
End Sub
I hope this provides enough info to get a better understanding of my
problem.
Thanks!
