Go Back   Access World Forums > Microsoft Access Discussion > Modules & VBA

Thread Tools Rate Thread Display Modes
Old 02-28-2017, 11:37 PM   #1
Newly Registered User
Join Date: Nov 2010
Posts: 185
Thanks: 55
Thanked 4 Times in 4 Posts
Cowboy_BeBa is on a distinguished road
Looping through all fields and saving metadata


Thanks for taking the time to read this, first off appologies for the title, i dunno how accurate it is but i honestly could not think of a concise way to explain what im trying to accomplish

Currently im looking into adding an audit trail into my db (long story short a lot of data is being changed/entered/deleted when it shoudlnt be, making a complete mess in the factory, need to identify the culprit)

Im adapting code i found on fontstuff (special thanks to Martin Green, no idea who he is but the man is a lifesaver, i recommend this article if youre looking into audit trails) and the function is simple enough so im not having any trouble there. However the one thing id like to add to Martin Greens audit trail is the ability to save the text of the entire record so i can see how the record looked before it was tampered with (or deleted), kinda like a snapshot of the entire unaltered record, will make it easier for me to change the data back if required)

what im after is simply a long string that looks something like:
"fieldname1: " & fielddata1 & " Fieldname2: " & fielddata2. etc....

The code from the audit table article i posted is below, it essentially gets some data from a table (any table in the database) and saves the data to another table (also defined in the article). im going to add a field to the AuditTrail table to save the new string i wanna make, plan to just add a line of code to save that string (ive changed the font colour to red to show ya what im adding), just not sure exactly how to go about actually creating the string to begin with

Sub AuditChanges(IDField As String, UserAction 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 RecShot as string
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    RecShot = "fieldname1: "& fielddata1 & "fieldname2: " & fielddata2.....
    Select Case UserAction
        Case "EDIT"
            For Each ctl In Screen.ActiveForm.Controls
                If ctl.Tag = "Audit" Then
                    If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                        With rst
                            ![DateTime] = datTimeCheck
                            ![UserName] = strUserID
                            ![FormName] = Screen.ActiveForm.Name
                            ![Action] = UserAction
                            ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                            ![FieldName] = ctl.ControlSource
                            ![OldValue] = ctl.OldValue
                            ![NewValue] = ctl.Value
                            ![RecordSnapshot] = RecShot
                        End With
                    End If
                End If
            Next ctl
        Case Else
            With rst
                ![DateTime] = datTimeCheck
                ![UserName] = strUserID
                ![FormName] = Screen.ActiveForm.Name
                ![Action] = UserAction
                ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                ![RecordSnapshot] = RecShot
            End With
    End Select
    On Error Resume Next
    Set rst = Nothing
    Set cnn = Nothing
    Exit Sub
    MsgBox Err.Description, vbCritical, "ERROR!"
    Resume AuditChanges_Exit
End Sub

Last edited by Cowboy_BeBa; 02-28-2017 at 11:46 PM.
Cowboy_BeBa is offline   Reply With Quote
Old 03-01-2017, 03:40 AM   #2
Newly Registered User
Join Date: Apr 2015
Location: KY,USA
Posts: 3,378
Thanks: 0
Thanked 747 Times in 732 Posts
Ranman256 will become famous soon enough Ranman256 will become famous soon enough
Re: Looping through all fields and saving metadata

paste in this function, then collect the fields via:
RecShot = getFields(rst)

function getFields(prst as recordset) as string
dim sRet as string
dim fld as field

for each fld in prst
  sRet = sRet & fld.value & ","
getFields = sRet

set fld = nothing
end function
Ranman256 is offline   Reply With Quote

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Changing Metadata Mark44stfc Queries 1 08-21-2015 08:45 PM
Continous Forms - Looping through records & Manipulating Fields On Form LarryB Forms 15 05-29-2015 06:54 AM
Looping fields within a report chok120 Reports 5 06-28-2007 08:31 AM
looping through table fields bjackson Tables 1 10-14-2004 05:06 PM
looping through fields Mcgrco Modules & VBA 2 02-05-2003 10:15 AM

All times are GMT -8. The time now is 12:23 PM.

Microsoft Access Help
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Featured Forum post

Sponsored Links

Powered by vBulletin®
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World