Navigation form -> call VBA module

[Bucephalus]

Hello,

lets say I have three forms - Form1,Form2 and Form3 linked to a navigation form with Navigation buttons. I have separate VBA codes under each Before update event of these forms, Form1,Form2 and Form3 to call a VBA module to track the changes performed by the users(Like an Audit Trail) in specified fields of the forms which will track them to a table.

there are control tags in the form properties --> others --> Tag to track the changes in the fields which are defined in the VBA Module.

this is the code to call the VBA Module:

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

Module:


Sub AuditChanges(IDField1 As String, IDField2 As String, UserAction As String)
On Error GoTo AuditChanges_Err
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim ctl As Control
Dim datTimeCheck As Date
Dim strUserID As String
Dim strComputerID As String
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = Environ("USERNAME")
strComputerID = Environ$("Computername")
Select Case UserAction
Case "EDIT"
For Each ctl In Screen.ActiveForm.Controls
If ctl.Tag = "Audit" Then
If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![ComputerName] = strComputerID
![FormName] = Screen.ActiveForm.Name
![Action] = UserAction
![RecordID] = Screen.ActiveForm.Controls(IDField1).Value
![PartNo] = Screen.ActiveForm.Controls(IDField2).Value
![FieldName] = ctl.ControlSource
![OldValue] = ctl.OldValue
![NewValue] = ctl.Value
.Update
End With
End If
End If
Next ctl
Case Else
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![Action] = UserAction
![RecordID] = Screen.ActiveForm.Controls(IDField1).Value
![PartNo] = Screen.ActiveForm.Controls(IDField2).Value
.Update
End With
End Select
AuditChanges_Exit:
On Error Resume Next
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Exit Sub
AuditChanges_Err:
MsgBox Err.Description, vbCritical, "ERROR!"
Resume AuditChanges_Exit
End Sub



The code is working perfect when the forms are run separately.
but when they are run from the navigation form by clicking the navigation buttons, the code is not working :banghead:!!
could anyone pls help or suggest?

kindly adjust to my ignorance if in case I missed anything.
I am just a beginner

Thanks in advance.

 

[MarkK]

The specific failure mode is important, so this is not enough information . . .

the code is not working

I would pass the form reference directly to the audit routine, so . . .

Call AuditChanges([COLOR="DarkRed"]Me[/COLOR], "Edit")

. . . and change the audit routine's signature . . .

Sub AuditChanges([COLOR="DarkRed"]frm as Access.Form[/COLOR], Action As String)

 

[Bucephalus]

Thanks Markk for your reply!!

I tried but I get an error when I compile for the code Call AuditChanges(Me , "EDIT") as "Argument not optional"

 

[annarocha]

Did you find a solution to this? I'm having this problem now.

 

[Bucephalus]

Nope, I can't remember I fixed it,
but I'm using another code now for Audit

 

[jdraw]

Perhaps you could show readers the code you are using now for Audit.

 

[Bucephalus]

Sure jdraw,

but it was a code found on the internet, here it goes but first create a table named as 'tblAudit' with fields as:

Audit_ID
User
DateTime
UniqID_Field
UniqID
Form
Field
Prev_Value
New_Value
Action
Reason
DelValues

**UniqID is your primary key and UniqID_Field is your name of the primary key field
***Audit_ID must be Autonumber

Code:

Public Function Audit_Trail(MyForm As Form, UniqID_Field As String, UniqID As String)
On Error GoTo Err_Audit_Trail

'Dim MyForm As Form
Dim ctl As Control
Dim ccnt As Control
Dim sUser As String

Dim strSql As String
Const cQUOTE = """" 'Thats 2 quotes in sequence

Dim action, nullval As String
nullval = "Null"

sUser = Environ("UserName") 'get the users login name

'If new record, record it in audit trail and exit function.
If MyForm.NewRecord = True Then
action = " NEW "
'Broken down into 4 separate variables for ease of view and troubleshooting
strSql = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, [Action])"
strSql = strSql & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
strSql = strSql & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
strSql = strSql & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & action & cQUOTE & ";"

DoCmd.SetWarnings False
DoCmd.RunSQL strSql
DoCmd.SetWarnings True

Exit Function
End If

Dim changecnt As Integer
changecnt = 0

'Check each data entry control for change and record old value of the control.
For Each ccnt In MyForm.Controls

Select Case ccnt.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
If ccnt.ControlSource Like "*" & "txt" & "*" Then GoTo TryNextCCNT 'Skip AuditTrail field.
If (ccnt.Value <> ccnt.OldValue) Or _
(IsNull(ccnt.Value) And Len(ccnt.OldValue) > 0 Or ccnt.Value = "" And Len(ccnt.OldValue) > 0) Then
changecnt = changecnt + 1
End If
End Select

TryNextCCNT:
Next ccnt

'If changecnt > 0 Then
'gstrReason = InputBox("Reason for change(s)?", "Reason for change(s)?")
'End If

'Check each data entry control for change and record old value of the control.
For Each ctl In MyForm.Controls

'Only check data entry type controls.
Select Case ctl.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox
If ctl.ControlSource Like "*" & "txt" & "*" Then GoTo TryNextControl 'Skip AuditTrail field.
If ctl.Value <> ctl.OldValue Then
action = " EDIT "

'Broken down into 4 separate variables for ease of view and troubleshooting
strSql = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, Field, Prev_Value, New_Value, [Action])"
strSql = strSql & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
strSql = strSql & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
strSql = strSql & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & ctl.ControlSource & cQUOTE & ", " & cQUOTE & ctl.OldValue & cQUOTE
strSql = strSql & ", " & cQUOTE & ctl.Value & cQUOTE & ", " & cQUOTE & action & cQUOTE & ";"

DoCmd.SetWarnings False
DoCmd.RunSQL strSql
DoCmd.SetWarnings True

'If old value is Null and new value is not Null
ElseIf IsNull(ctl.OldValue) And Len(ctl.Value) > 0 Or ctl.OldValue = "" And Len(ctl.Value) > 0 Then
action = " ADD "

'Broken down into 4 separate variables for ease of view and troubleshooting
strSql = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, Field, Prev_Value, New_Value, [Action])"
strSql = strSql & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
strSql = strSql & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
strSql = strSql & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & ctl.ControlSource & cQUOTE & ", " & cQUOTE & nullval & cQUOTE
strSql = strSql & ", " & cQUOTE & ctl.Value & cQUOTE & ", " & cQUOTE & action & cQUOTE & ";"

DoCmd.SetWarnings False
DoCmd.RunSQL strSql
DoCmd.SetWarnings True

'If new value is Null and old value is not Null
ElseIf IsNull(ctl.Value) And Len(ctl.OldValue) > 0 Or ctl.Value = "" And Len(ctl.OldValue) > 0 Then
action = " REMOVE "

'Broken down into 4 separate variables for ease of view and troubleshooting
strSql = "INSERT INTO tblAudit ( [User], [DateTime], UniqID_Field, UniqID, Form, Field, Prev_Value, New_Value, [Action])"
strSql = strSql & " SELECT " & cQUOTE & sUser & cQUOTE & ", " & cQUOTE & Now & cQUOTE & " , "
strSql = strSql & cQUOTE & UniqID_Field & cQUOTE & ", " & cQUOTE & UniqID & cQUOTE & ", "
strSql = strSql & cQUOTE & MyForm.Name & cQUOTE & ", " & cQUOTE & ctl.ControlSource & cQUOTE & ", " & cQUOTE & ctl.OldValue & cQUOTE
strSql = strSql & ", " & cQUOTE & nullval & cQUOTE & ", " & cQUOTE & action & cQUOTE & ";"

DoCmd.SetWarnings False
DoCmd.RunSQL strSql
DoCmd.SetWarnings True
End If

End Select

TryNextControl:
Next ctl

Exit_Audit_Trail:
Exit Function

Err_Audit_Trail:
If Err.Number = 2001 Then 'You canceled the previous operation.
'do nothing
Else
Beep
MsgBox Err.Number & " - " & Err.Description
End If
Resume Exit_Audit_Trail

End Function
________________________________________________________________

Now, go to your form which needs to Audit and in the Before update event of the Form, add this code below:

Private Sub Form_BeforeUpdate(Cancel As Integer)
Call Audit_Trail(Me, "UniqueID", UniqueID.Value)
End Sub

 

[jdraw]

Any instructions etc for your code?
3 other sources of audit trail info

1) Allen Browne
    http://allenbrowne.com/AppAudit.html
    http://allenbrowne.com/AppAuditCode.html

2) Martin Green
    http://www.fontstuff.com/access/acctut21.htm

3) UtterAccess (sample db with class module)
   http://www.utteraccess.com/forum/Audit-Trail-Database-S-t1576962.html