Trouble calling audit module in form vba

[Dkub]

First time posting, so please excuse if I pull a moron in my questions.

I have the following:
2 audit modules: basEmplAudit and basEmplDeptAudit
1 query (tblEmployee left join tblEmployeeDepartment)
1 form using the above query as record source

For this particular form I'm trying to avoid using a subform for the Department. However, I still want the form to write changes to 2 separate audit tables (tblEmployeeAudit and tblEmployeeDepartmentAudit). I have tags identifying which controls are aligned to these two audit tables.

If I call either the EmplAudit or EmplDeptAudit individually from the form, this code works smoothly every time. However, when I try to combine calling the audits by evaluating the tags I get the "operation is not supported for this type of object" error.

I would appreciate any help you can provide for that form code - - I'm certain that's where the error is and I've tried dozens of permutations to get this working - - I'm also pretty sure this is a newbie mistake...

Here are the basEmplAudit and basEmplDeptAudit modules:

Option Compare Database
Option Explicit
Public Function WriteAuditEmpl(frm As Form, lngID As Long) As Boolean
On Error GoTo err_WriteAuditEmpl
    Dim ctlC As Control
    Dim strSQL As String
    Dim bOK As Boolean
 
    bOK = False
 
    DoCmd.SetWarnings False
 
    ' For each control.
    For Each ctlC In frm.Controls
        If TypeOf ctlC Is TextBox Or TypeOf ctlC Is ComboBox Then
            If ctlC.Value <> ctlC.OldValue Or IsNull(ctlC.OldValue) Then
                If Not IsNull(ctlC.Value) Then
                    strSQL = "INSERT INTO tblEmployeeAudit ( tblEmplAuditID, FieldChanged, FieldChangedFrom, FieldChangedTo, User, DateOfChange ) " & _
                        " SELECT " & lngID & " , " & _
                        "'" & ctlC.Name & "', " & _
                        "'" & ctlC.OldValue & "', " & _
                        "'" & ctlC.Value & "', " & _
                        "'" & GetUserName & "', " & _
                        "'" & Now & "'"
                    'Debug.Print strSQL
                    DoCmd.RunSQL strSQL
                End If
            End If
        End If
    Next ctlC
 
    WriteAuditEmpl = bOK
 
exit_WriteAuditEmpl:
    DoCmd.SetWarnings True
    Exit Function
 
err_WriteAuditEmpl:
    MsgBox Err.Description
    Resume exit_WriteAuditEmpl
 
End Function

Option Compare Database
Option Explicit
Public Function WriteAuditEmplDept(frm As Form, lngID As Long) As Boolean
On Error GoTo err_WriteAuditEmplDept
    Dim ctlC As Control
    Dim strSQL As String
    Dim bOK As Boolean
 
    bOK = False
 
    DoCmd.SetWarnings False
 
    ' For each control.
    For Each ctlC In frm.Controls
        If InStr(ctlC.Tag, "tagEmplDeptAudit") Then
            If TypeOf ctlC Is TextBox Or TypeOf ctlC Is ComboBox Then
                If ctlC.Value <> ctlC.OldValue Or IsNull(ctlC.OldValue) Then
                    If Not IsNull(ctlC.Value) Then
                        strSQL = "INSERT INTO tblEmployeeDepartmentAudit ( tblEmplDeptAuditID, FieldChanged, FieldChangedFrom, FieldChangedTo, User, DateOfChange ) " & _
                               " SELECT " & lngID & " , " & _
                               "'" & ctlC.Name & "', " & _
                               "'" & ctlC.OldValue & "', " & _
                               "'" & ctlC.Value & "', " & _
                               "'" & GetUserName & "', " & _
                               "'" & Now & "'"
                        'Debug.Print strSQL
                        DoCmd.RunSQL strSQL
                    End If
                End If
            End If
        End If
    Next ctlC
 
    WriteAuditEmplDept = bOK
 
exit_WriteAuditEmplDept:
    DoCmd.SetWarnings True
    Exit Function
 
err_WriteAuditEmplDept:
    MsgBox Err.Description
    Resume exit_WriteAuditEmplDept
End Function

Here is the form code with which I'm having the issue:

Private Sub Form_BeforeUpdate(Cancel As Integer)
    Dim strMsg As String
    Dim iResponse As Integer
    Dim x As Integer
    Dim y As Integer
    Dim ctl As Control
    strMsg = "Do you wish to save your changes?" & Chr(10)
    strMsg = strMsg & "Click Yes to Save or No to Discard All Changes."
    iResponse = MsgBox(strMsg, vbQuestion + vbYesNo, "Save Record?")
 
    If iResponse = vbNo Then
        DoCmd.RunCommand acCmdUndo
        Cancel = True
    End If
 
    If iResponse = vbYes Then
        For Each ctl In Me.Controls
        If InStr(ctl.Tag, "tagEmplAudit") Then
            x = WriteAuditEmpl(Me, Me!tblEmplID)
            Else
                If InStr(ctl.Tag, "tagEmplDeptAudit") Then
                    y = WriteAuditEmplDept(Me, Me!tblEmplDeptID)
                End If
        End If
        Next ctl
    End If
 
End Sub

 

[MarkK]

Hey there, welcome to the forum.
What line causes the error?
Also, it appears that you enumerate all the controls on the form multiple times, for instance in your BeforeUpdate handler you check the tag of each control. Depending on the value of that tag you may call a routine that again enumerates all the controls on the form. This seems excessive.

 

[Dkub]

I think the area of issue is in the BeforeUpdate as well. When I keep the code to checking one tag, i.e. tagEmplAudit, and eliminate the Else statement, the code works. Is there a way to evaluate multiple tags and call the associated audit modules?

 

[MarkK]

I restate: What line causes the error?
I restate: You have redundant loops. It doesn't make sense that you enumerate all the controls on the form in your BeforeUpdate event AND again enumerate all the controls on your form in your audit routine.
And while I'm at it, Hey, welcome to the forum!!!

 

[Dkub]

Thank you for your quick responses

When I test the form, it gives me a popup with the "operation is not supported ... " error, but it doesn't give me a end/debug option (just the ok button). Therefore, I'm not certain exactly what line it is - - unless there is another way for me to test? I'm open to all suggestions.

Also, with the looping ... I originally had the tag lines in the audit modules, but I would get the same error as I'm now getting when they're in the BeforeUpdate. I'm open here to all suggestions too, to eliminate the redundancies because not only is it not working, but I'm afraid if I did get it working it might slow processing down for the user. I just can't put my finger on a better solution - - hence the post

Any help or suggestions you can provide are welcome!

 

[JANR]

"operation is not supported ... " error, but it doesn't give me a end/debug option (just the ok button).

Comment out your " On Error GoTo..." in your functions to get the debug option.

JR

 

[MarkK]

OK, do you see how in your BeforeUpdate routine you traverse all the controls on the form?

For Each ctl In Me.Controls
  If InStr(ctl.Tag, "tagEmplAudit") Then
    x = WriteAuditEmpl(Me, Me!tblEmplID)
  ElseIf InStr(ctl.Tag, "tagEmplDeptAudit") Then
    y = WriteAuditEmplDept(Me, Me!tblEmplDeptID)
  End If
Next ctl

In your function calls, say WriteAuditEmpl() consider passing in just then current control ctl, rather than the whole form....

    x = WriteAuditEmpl(ctl, Me.tblEmpID)

...so the function call only operates on the single control which vastly simplifies your function calls ...

Public Function WriteAuditEmpl(ctlC As control, lngID As Long) As Boolean
    Dim strSQL As String
    If ctlC.Value <> ctlC.OldValue Or IsNull(ctlC.OldValue) Then
        If Not IsNull(ctlC.Value) Then
            strSQL = "INSERT INTO tblEmployeeAudit ( tblEmplAuditID, FieldChanged, FieldChangedFrom, FieldChangedTo, User, DateOfChange ) " & _
                " SELECT " & lngID & " , " & _
                "'" & ctlC.Name & "', " & _
                "'" & ctlC.OldValue & "', " & _
                "'" & ctlC.Value & "', " & _
                "'" & GetUserName & "', " & _
                "'" & Now & "'"
                CurrentDb.Execute strSQL, dbFailOnError
        End If
    End If
End Function

... and saves you from doing all the same work twice.
Gotta run,

 

[Dkub]

Thank you for your responses!

I've tried the new method and it wouldn't evaluate any of the controls at all ...

I tried combined the audit modules and I feel this is closer, but it doesn't seem to handle the "else" statement. Is there a workaround?

new combined module (applicable section):

For Each ctlC In frm.Controls
If TypeOf ctlC Is TextBox Or TypeOf ctlC Is ComboBox Then
If ctlC.Value <> ctlC.OldValue Or IsNull(ctlC.OldValue) Then
If Not IsNull(ctlC.Value) Then
If InStr(ctlC.Tag, "tagEmplAudit") Then
strSQL = "INSERT INTO tblEmployeeAudit ( tblEmplAuditID, FieldChanged, FieldChangedFrom, FieldChangedTo, User, DateOfChange ) " & _
" SELECT " & lngID & " , " & _
"'" & ctlC.Name & "', " & _
"'" & ctlC.OldValue & "', " & _
"'" & ctlC.Value & "', " & _
"'" & GetUserName & "', " & _
"'" & Now & "'"
'Debug.Print strSQL
DoCmd.RunSQL strSQL
Else
strSQL = "INSERT INTO tblEmployeeDepartmentAudit ( tblEmplDeptAuditID, FieldChanged, FieldChangedFrom, FieldChangedTo, User, DateOfChange ) " & _
" SELECT " & lngID & " , " & _
"'" & ctlC.Name & "', " & _
"'" & ctlC.OldValue & "', " & _
"'" & ctlC.Value & "', " & _
"'" & GetUserName & "', " & _
"'" & Now & "'"
'Debug.Print strSQL
DoCmd.RunSQL strSQL
End If
End If
End If
End If
Next ctlC

 

[MarkK]

The code I posted audits changes to a single control using your logic and your process. At some point it will come down to that.
And OK, traverse all the controls in the function call, but then don't also do it in the BeforeUpdate handler. That's really my main point. Do you see what I mean by that?