Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 82
  • Last Modified:

Audit changes on a form

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
SteveL13
Asked:
SteveL13
  • 5
  • 5
1 Solution
 
Eric ShermanAccountant/DeveloperCommented:
<<<<I want the real values written, not the PK numbers.>>>>

Can you explain further???

ET
0
 
Rey Obrero (Capricorn1)Commented:
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
 
Rey Obrero (Capricorn1)Commented:
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
Visualize your virtual and backup environments

Create well-organized and polished visualizations of your virtual and backup environments when planning VMware vSphere, Microsoft Hyper-V or Veeam deployments. It helps you to gain better visibility and valuable business insights.

 
SteveL13Author Commented:
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
 
Rey Obrero (Capricorn1)Commented:
0
 
SteveL13Author Commented:
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
 
Rey Obrero (Capricorn1)Commented:
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
 
SteveL13Author Commented:
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
 
Rey Obrero (Capricorn1)Commented:
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
 
SteveL13Author Commented:
That did it.  Thank you.
0
 
SteveL13Author Commented:
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!

  • 5
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now