Track changes in subform (1 Viewer)

hllary

Registered User.
Local time
Today, 06:56
Joined
Sep 23, 2019
Messages
80
I'm trying to track changes made to a subform. Anything added, deleted, or editted will be recorded in a table called Audit_tbl. When I make a add or edit a record i get a 3001:Invalid argument error. I'm calling the function in the form as Before Update event procedure.

Attached are the reference libraries I've added.

Code:
Public Function AuditChanges(RecordID As String, UserAction As String)
On Error GoTo auditerr

Dim db As Database
Dim rst As Recordset
Dim clt As Control
Dim userloging As String

Set db = CurrentDb
Set rst = db.OpenRecordset("Select *from audit_tbl", adopendynamic)

UserLogin = Environ("Username")
Select Case UserAction
    Case "new"
        With rst
            .AddNew
            ![DateTime] = Now()
            ![UserName] = UserLogin
            ![FormName] = Screen.ActiveForm.Name
            ![Action] = UserAction
            ![RecordID] = Screen.ActiveForm.Controls(RecordID).Value
            .Update
            
        End With
        
    Case "Delete"
        With rst
            .AddNew
            ![DateTime] = Now()
            ![UserName] = UserLogin
            ![FormName] = Screen.ActiveForm.Name
            ![Action] = UserAction
            ![RecordID] = Screen.ActiveForm.Controls(RecordID).Value
            .Update
         End With
    
    Case "edit"
        For Each clt In Screen.ActiveForm.Controls
            If (clt.ControlType = acTextBox) _
                Or (clt.ControlType = acComboBox) Then
                If Nz(clt.Value) <> Nz(clt.OldValue) Then
                    With rst
                        .AddNew
                        ![DateTime] = Now()
                        ![UserName] = UserLogin
                        ![FormName] = Screen.ActiveForm.Name
                        ![Action] = UserAction
                        ![RecordID] = Screen.ActiveForm.Controls(RecordID).Value
                        ![FieldName] = clt.ControlSource
                        ![OldValue] = clt.Value
                        .Update
                    End With
                End If
          End If
    Next clt
End Select
rst.Close
db.Close
Set rst = Nothing
Set db = Nothing

auditerr:
    MsgBox Err.Number & " : " & Err.Description, vbCritical, "Error"
    Exit Function

End Function
 

Attachments

  • Capture.JPG
    Capture.JPG
    28.5 KB · Views: 338

Uncle Gizmo

Nifty Access Guy
Staff member
Local time
Today, 13:56
Joined
Jul 9, 2003
Messages
16,244
I haven't examined your code because I thought I should mention that audit is a very common requirement, and has been discussed frequently on the forum and there are several code examples. In other words unless you've got a good reason, I would examine those first before reinventing the wheel.
 

The_Doc_Man

Immoderate Moderator
Staff member
Local time
Today, 08:56
Joined
Feb 28, 2001
Messages
26,999
First, I noticed something that might not make a difference, but Access is known to sometimes be a bit persnickety about this:

Code:
Set rst = db.OpenRecordset("Select *from audit_tbl", adopendynamic)

Try putting a space between the asterisk and FROM.

Second, when you get error 3001, does it highlight a particular line? If so, which one.
 

CJ_London

Super Moderator
Staff member
Local time
Today, 13:56
Joined
Feb 19, 2013
Messages
16,553
not sure if this has a bearing on what you are trying to do but the screen.activeform is the main form, not the subform.

for clarity, your recordset should be dimmed as dao.recordset

dao is the default for access as is the type used with the rest of your code.

Other comment is this line
Set rst = db.OpenRecordset("Select *from audit_tbl", adopendynamic)
you don't need to bring all the records through, suggest change your sql to

"Select * from audit_tbl WHERE False"
 

hllary

Registered User.
Local time
Today, 06:56
Joined
Sep 23, 2019
Messages
80
The error message does not highlight a particular line. the error message is coming from the auditerr: MsgBox. If I turn off the msgbox, the audit table is still blank.
I've have added the space between "* FROM" and made the changes suggested by CJ, but I'm still getting the same error.
 

hllary

Registered User.
Local time
Today, 06:56
Joined
Sep 23, 2019
Messages
80
The problem is somewhat solved... I've added the ms activeX data objects recordset.... library to the reference. And i do not get the error message but I'm not getting the correct info.
What the table audit table shows for OldValue is actually the new value and the NewValue field is blank. And the RecordID is blank.
 

Attachments

  • Capture2.JPG
    Capture2.JPG
    43.7 KB · Views: 234

bastanu

AWF VIP
Local time
Today, 06:56
Joined
Apr 13, 2010
Messages
1,401
This is what I use for subforms, adapt as per your naming convention:

SQL:
Function AddToAuditTrailSub()
'  Skip if this is a new record
On Error Resume Next

If Screen.ActiveForm.ActiveControl.Form.NewRecord Then Exit Function

'This procedure appends Before and After values of controls and records this information in an audit trail table (tblAuditTrail)
'It records the old value and value properties of the changed control
With CurrentDb.OpenRecordset("tblAuditTrail")
        .AddNew                         ' Add new record.
        !IDField = Screen.ActiveForm.ActiveControl.Form.ActiveControl.Name
        !Before = Screen.ActiveForm.ActiveControl.Form.ActiveControl.OldValue
        !After = Screen.ActiveForm.ActiveControl.Form.ActiveControl.Value
        !Updated = Now()
        !Form = Screen.ActiveForm.Caption
        !User = Forms![Main Switchboard Form]!Username
        On Error Resume Next
       
        .Update                         ' Save changes.
        .Close
End With

End Function

Cheers,
Vlad
 

CJ_London

Super Moderator
Staff member
Local time
Today, 13:56
Joined
Feb 19, 2013
Messages
16,553
The error message does not highlight a particular line. the error message is coming from the auditerr: MsgBox.
that's because of your on error goto line. comment it out until you have resolved the problem. Also just noticed - you need to put exit function before your error code otherwise the error message will run every time the function is run
 

The_Doc_Man

Immoderate Moderator
Staff member
Local time
Today, 08:56
Joined
Feb 28, 2001
Messages
26,999
Much worse than that, CJ, and thanks for calling attention to it.

Code:
On Error GoTo auditerr
...
db.Close
Set rst = Nothing
Set db = Nothing

auditerr:
    MsgBox Err.Number & " : " & Err.Description, vbCritical, "Error"
    Exit Function


You can NEVER do this. EVER. This is a potentially fatal error. If you ever take the trap and then perform an EXIT FUNCTION (as your code currently does), you are killing the program context. By context, I mean the hardware registers and memory management setup. The thing that lets the cpu find your code in the first place.

You see, an "ON ERROR" creates a TRAP context which is RADICALLY DIFFERENT than a sub/function invocation. The TRAP is triggered by essentially an interrupt, often of an asynchronous nature, whereas a subroutine or function is activated by a predictable code sequence. Oh, there might be some type of "call/no call" logic involved - but if the call occurs, it is from a predictable context and situation.

The ONLY correct way to exit from an error handler is via a RESUME command, which may be "RESUME NEXT" or "RESUME label" - because the TRAP context, being an interrupt, saved different stuff on the hardware stack than would be saved by a procedure call. If you don't RESUME from the error, you cannot possibly continue with other things in the program because the context is now totally wrong.

Change the above to something like this:

Code:
    On Error GoTo auditerr
...
    db.Close
    Set rst = Nothing
    Set db = Nothing
NormalClose:
    Exit Function

auditerr:
    MsgBox Err.Number & " : " & Err.Description, vbCritical, "Error"
    Resume NormalClose

Whether this fixes your other problem or not, do this. Because what you had WILL break your app.

EDIT: Or move the "NormalClose:" label so that it closes and resets the recordset and resets the db pointer, although there are arguments for not having to do that since they are locally declared.
 
Last edited:

Users who are viewing this thread

Top Bottom