?
Solved

Audit changes on a form

Posted on 2016-10-24
11
Medium Priority
?
62 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
Industry Leaders: 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!

 

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 2000 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

Does Your Cloud Backup Use Blockchain Technology?

Blockchain technology has already revolutionized finance thanks to Bitcoin. Now it's disrupting other areas, including the realm of data protection. Learn how blockchain is now being used to authenticate backup files and keep them safe from hackers.

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.
Traditionally, the method to display pictures in Access forms and reports is to first download them from URLs to a folder, record the path in a table and then let the form or report pull the pictures from that folder. But why not let Windows retr…
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
Suggested Courses

765 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