Solved

Audit changes on a form

Posted on 2016-10-24
11
42 Views
Last Modified: 2016-10-25
I have several fields on a form that have "Audit" in the Property Sheet > Other - Tag Field.

Then in the form's beforeupdate event I have this code:

Call AuditChanges("Customer_ID")

So this code is being called:

Sub AuditChanges(IDField 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
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    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] = Environ("USERNAME")
                    ![FormName] = Screen.ActiveForm.Name
                    ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                    ![FieldName] = ctl.ControlSource
                    ![OldValue] = ctl.OldValue
                    ![NewValue] = ctl.Value
                    .Update
                End With
            End If
        End If
    Next ctl
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

Open in new window


But where OldValue and NewValue are being written to the table, tblAuditTrail, I want the real values written, not the PK numbers.  How can this be done?
0
Comment
Question by:SteveL13
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 5
11 Comments
 
LVL 19

Expert Comment

by:Eric Sherman
ID: 41857497
<<<<I want the real values written, not the PK numbers.>>>>

Can you explain further???

ET
0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 41857507
your code is recording to the table tblAuditTrail the following
      the RecordID - ("Customer_ID")
      the name of the field that was change - FieldName
      the New value
      the Old value


what else are you looking for?
0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 41857510
if you want the CustomerName, just create  a query using the tblAudit and the Customer table with a Join in the "Customer_ID", and place the CustomerName from table Customer in the query
0
PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

 

Author Comment

by:SteveL13
ID: 41858535
I have put together a test d/b for demonstration.  If you would please, for example, change the current record displaying on the form from Position = "Boss" to Position = "President" and click [Save Record].  You will see what I am trying to do.

Open the table, tblAuditTrail.  You will find that your newest record recorded which you just added  shows the OldValue and NewValue fields as the PK of the tblPositions.  Instead of writing the PK to the table I want the text of the changes, before and after, to be written.  So instead of OldValue being "1" it should be "2".

I sure hope this makes sense.
Audit-Test.accdb
0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 41858676
0
 

Author Comment

by:SteveL13
ID: 41858875
Rey,

Getting close.  But because more than one combo-box may change I tried to alter your code like this which isn't working...

Sub AuditChanges(IDField 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 Part_No As String
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    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] = Environ("USERNAME")
                    ![FormName] = Screen.ActiveForm.Name
                    ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                    ![FieldName] = ctl.ControlSource
                    
                If ctl.Name = "cboPositionID" Then
                    ![OldValue] = DLookup("Description", "tblPositions", "positionID=" & ctl.OldValue)
                    ![NewValue] = DLookup("Description", "tblPositions", "positionID=" & ctl.Value)
                    Else
                    ![OldValue] = ctl.OldValue
                    ![NewValue] = ctl.Value
                End If
                
                If ctl.Name = "cboCompanyID" Then
                    ![OldValue] = DLookup("CompanyName", "tblCompanies", "CompanyID=" & ctl.OldValue)
                    ![NewValue] = DLookup("CompanyName", "tblCompanies", "CompanyID=" & ctl.Value)
                    Else
                    ![OldValue] = ctl.OldValue
                    ![NewValue] = ctl.Value
                End If
                
                    .Update
                End With
            End If
        End If
    Next ctl
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

Open in new window


I've re-attached my altered d/b in case you want to see it and see what's happening.
Audit-Test_Rev-2.accdb
0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 41858958
use this codes

Sub AuditChanges(IDField 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 Part_No As String
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    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] = Environ("USERNAME")
                    ![FormName] = Screen.ActiveForm.Name
                    ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                    ![FieldName] = ctl.ControlSource
                    
                If ctl.Name = "cboPositionID" Then
                    ![OldValue] = DLookup("Description", "tblPositions", "positionID=" & ctl.OldValue)
                    ![NewValue] = DLookup("Description", "tblPositions", "positionID=" & ctl.Value)
                End If
                
                If ctl.Name = "cboCompanyID" Then
                    ![OldValue] = DLookup("CompanyName", "tblCompanies", "CompanyID=" & ctl.OldValue)
                    ![NewValue] = DLookup("CompanyName", "tblCompanies", "CompanyID=" & ctl.Value)
                End If
                
                    .Update
                End With
            End If
        End If
    Next ctl
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

Open in new window

0
 

Author Comment

by:SteveL13
ID: 41859013
That worked for the two comboboxes.  But if I change a value in either of the other 3 textbox fields, the old and new values are not recorded.
0
 
LVL 120

Accepted Solution

by:
Rey Obrero (Capricorn1) earned 500 total points
ID: 41859024
use this then

Sub AuditChanges(IDField 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 Part_No As String
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    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] = Environ("USERNAME")
                    ![FormName] = Screen.ActiveForm.Name
                    ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                    ![FieldName] = ctl.ControlSource
                    
                If ctl.Name = "cboPositionID" Then
                    ![OldValue] = DLookup("Description", "tblPositions", "positionID=" & ctl.OldValue)
                    ![NewValue] = DLookup("Description", "tblPositions", "positionID=" & ctl.Value)
                    ElseIf ctl.Name = "cboCompanyID" Then
                    ![OldValue] = DLookup("CompanyName", "tblCompanies", "CompanyID=" & ctl.OldValue)
                    ![NewValue] = DLookup("CompanyName", "tblCompanies", "CompanyID=" & ctl.Value)
                    Else
                    ![OldValue] = ctl.OldValue
                    ![NewValue] = ctl.Value
                End If
                
                
                    .Update
                End With
            End If
        End If
    Next ctl
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

Open in new window

0
 

Author Comment

by:SteveL13
ID: 41859029
That did it.  Thank you.
0
 

Author Closing Comment

by:SteveL13
ID: 41859030
Thanks again.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In earlier versions of Windows (XP and before), you could drag a database to the taskbar, where it would appear as a taskbar icon to open that database.  This article shows how to recreate this functionality in Windows 7 through 10.
Access custom database properties are useful for storing miscellaneous bits of information in a format that persists through database closing and reopening.  This article shows how to create and use them.
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…

738 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question