Looping through all fields and saving metadata (1 Viewer)

[Cowboy_BeBa]

Hi

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
    [COLOR="Red"]Dim RecShot as string[/COLOR]
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
[COLOR="red"]    RecShot = "fieldname1: "& fielddata1 & "fieldname2: " & fielddata2.....[/COLOR]
    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
                            .AddNew
                            ![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
                            [COLOR="Red"]![RecordSnapshot] = RecShot[/COLOR]
                            .Update
                        End With
                    End If
                End If
            Next ctl
        Case Else
            With rst
                .AddNew
                ![DateTime] = datTimeCheck
                ![UserName] = strUserID
                ![FormName] = Screen.ActiveForm.Name
                ![Action] = UserAction
                ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                [COLOR="Red"]![RecordSnapshot] = RecShot[/COLOR]
                .Update
            End With
    End Select
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

 

[Ranman256]

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 & ","
next
getFields = sRet

set fld = nothing
end function