Solved

Audit changes on a form

Posted on 2016-10-24
11
20 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
  • 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 119

Expert Comment

by:Rey Obrero
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 119

Expert Comment

by:Rey Obrero
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
 

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 119

Expert Comment

by:Rey Obrero
ID: 41858676
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

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 119

Expert Comment

by:Rey Obrero
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 119

Accepted Solution

by:
Rey Obrero 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

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

It took me quite some time to sort out all the different properties of combo and list boxes available from Visual Basic at run-time. Not that the documentation is lacking: the help pages are quite thorough and well written. The problem was rather wh…
Regardless of which version on MS Access you are using, one of the harder data-entry forms to create is one where most data from previous entries needs to be appended to new records, especially when there are numerous fields and records involved.  W…
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…
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…

706 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

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now