Solved

Audit changes on a form

Posted on 2016-10-24
11
49 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

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Question has a verified solution.

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

As tax season makes its return, so does the increase in cyber crime and tax refund phishing that comes with it
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…
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
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…

717 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