Audit Trail subroutine works for Forms, but not SubForms

[RbTrail]

The following code works wonderfully for all of my simple forms, but nothing is recorded in tblAuditTrail if an edit is made in a subform. I've tried calling the sub from the subform's events, but it still doesn't work.

I suspect the problem is in "![FormName]=Screen.ActiveForm.Name", but I have no idea how to fix it.

Option Compare Database
[COLOR="SeaGreen"]'from Martin Green's Access Tips at http://www.fontstuff.com/access/acctut21.htm[/COLOR]
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
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    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
                            [COLOR="Red"]![FormName] = Screen.ActiveForm.Name[/COLOR]
                            ![Action] = UserAction
                            ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                            ![FieldName] = ctl.ControlSource
                            ![OldValue] = ctl.OldValue
                            ![NewValue] = ctl.Value
                            .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
                .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

Any ideas?

 

[theDBguy]

Hmm, this question looks familiar. Let me see if I can find a previous similar discussion with a solution for you.

 

[theDBguy]

Hi. It sounded familiar to me because I remember something similar I worked on earlier, but it turns out it was at the other forum. Please have a look at this other discussion on the same topic and let us know if it helps or not. Cheers!

 

[RbTrail]

Thank you! That works wonderfully.
For those who are interested, here is the corrected code:

Option Compare Database
[COLOR="SeaGreen"]'from Martin Green's Access Tips at http://www.fontstuff.com/access/acctut21.htm[/COLOR]
[COLOR="Red"]'changes by theDBguy highlighted in red[/COLOR]
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
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
    rst.Open "SELECT * FROM tblAuditTrail", cnn, adOpenDynamic, adLockOptimistic
    datTimeCheck = Now()
    strUserID = Environ("USERNAME")
    Select Case UserAction
        Case "EDIT"
            For Each ctl In [COLOR="red"]Screen.ActiveForm.ActiveControl.Form[/COLOR]
                If ctl.Tag = "Audit" Then
                    If Nz(ctl.Value) <> Nz(ctl.OldValue) Then
                        With rst
                            .AddNew
                            ![DateTime] = datTimeCheck
                            ![UserName] = strUserID
                            ![FormName] = [COLOR="red"]Screen.ActiveForm.ActiveControl.Form.Name[/COLOR]
                            ![Action] = UserAction
                            ![RecordID] = [COLOR="red"]Screen.ActiveControl.Parent.Form(IDField).Value[/COLOR]
                            ![FieldName] = ctl.ControlSource
                            ![OldValue] = ctl.OldValue
                            ![NewValue] = ctl.Value
                            .Update
                        End With
                    End If
                End If
            Next ctl
                Case Else
                    With rst
                        .AddNew
                        ![DateTime] = datTimeCheck
                        ![UserName] = strUserID
                        ![FormName] = [COLOR="red"]Screen.ActiveForm.ActiveControl.Form.Name[/COLOR]
                        ![Action] = UserAction
                        ![RecordID] = [COLOR="red"]Screen.ActiveControl.Parent.Form(IDField).Value[/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

 

[theDBguy]

Hi. Glad to hear you got it to work. Good luck with your project.