Access 2013 Audit Trail VBA Error "Operation is not supported for this type of object"

[geospatial]

I have 3 tables and a form being used for this Audit Trail. After I have an update and move to another record or close the form I get the error "Operation is not supported for this type of object". To be fair even with the error the audit trail actually works fine, I just dont want to have the error show up every time we make a change. I did not write the original code. I got it from Audit Trail in Access Forms in 6 Steps - How To Create Audit Trail so there are some things I was not familiar with and why they are in the code.

tblAuditTrail, tblEmployees, and tbSections.

tblAudit Trail

• ChangeID (AutoNumber)
• DateTime (Date/Time)
• UserID (Short Text)
• FormName (Short Text)
• FieldName (Short Text)
• OldValue (Short Text)
• NewValue (Short Text)
• Action (Short Text)
• RecordID (Short Text)
• FormRecordID (Short Text)

tblEmployees

• IDEmployees (AutoNumber)
• employeeFirstName (Short Text)
• employeeLastName (Short Text)
• employeeMiddleInitial (Short Text)
• employeePhone (Short Text)
• IDSections(Number, Foreign Key)

tblSections

• IDSections (AutoNumber)
• SectionName (Short Text)

I have frmEmployees with the employeeFirstName, employeeLastName, employeeMiddleInitial, employeePhone, and SectionName fields

In a standard module I have the following VBA.

Option Compare Database
Option Explicit
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
        ![FormName] = Screen.ActiveForm.Name
        ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
        ![FieldName] = ctl.ControlSource
        ![OldValue] = ctl.OldValue
        ![NewValue] = ctl.Value
        ![UserID] = strUserID
        ![DateTime] = datTimeCheck
        ![Action] = UserAction
        ![FormRecordID] = Screen.ActiveForm.CurrentRecord
    
    .Update
    End With
    End If
    End If
    Next ctl
    Case Else
    
    With rst
    .AddNew
        ![DateTime] = datTimeCheck
        ![UserID] = 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

For Before Update I have

Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo errHandler

If Me.NewRecord Then
Call AuditChanges("IDEmployees", "NEW")
Else
Call AuditChanges("IDEmployees", "EDIT")
End If
Exit Sub

errHandler:
MsgBox "Error" & Err.Number & ": " & Err.Description & " in " & _
VBE.ActiveCodePane.CodeModule, vbOKOnly, "Error"

End Sub

For After Delete and Confirm I have

Private Sub Form_AfterDelConfirm(Status As Integer)
On Error GoTo errHandler
If Status = acDeleteOK Then Call AuditChanges("ContactID", "DELETE")
Exit Sub

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description & " in " & _
VBE.ActiveCodePane.CodeModule, vbOKOnly, "Error"
End Sub

 

[JonXL]

It would help to know what the "operation" is, that is, where in the code the error comes up.

 

[geospatial]

I put in the paragraph that it shows when going to a new record or when exiting out of the form.

 

[welshgasman]

Have you by chance completed a tag for a control that cannot have a Value.?

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
                        ![FormName] = Screen.ActiveForm.Name
                        ![RecordID] = Screen.ActiveForm.Controls(IDField).Value
                        ![FieldName] = ctl.ControlSource
                        ![OldValue] = ctl.OldValue
                        ![NewValue] = ctl.Value
                        ![UserID] = strUserID
                        ![DateTime] = datTimeCheck
                        ![Action] = UserAction
                        ![FormRecordID] = Screen.ActiveForm.CurrentRecord

                        .Update
                    End With
                End If
            End If
        Next ctl
    Case Else

        With rst
            .AddNew
            ![DateTime] = datTimeCheck
            ![UserID] = 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

Private Sub Form_BeforeUpdate(Cancel As Integer)
    On Error GoTo errHandler

    If Me.NewRecord Then
        Call AuditChanges("IDEmployees", "NEW")
    Else
        Call AuditChanges("IDEmployees", "EDIT")
    End If
    Exit Sub

errHandler:
    MsgBox "Error" & Err.Number & ": " & Err.Description & " in " & _
           VBE.ActiveCodePane.CodeModule, vbOKOnly, "Error"

End Sub

 

[welshgasman]

From anothe forum where someone was asking the same thing, perhaps check the control type?

For Each ctl In Me.Controls
   Select Case ctl.Type
     Case acTextBox, acListBox, acCheckBox, etc.
       If ctl.ControlSource <> "" Then
         If ctl.Value <> ctl.OldValue Then
'          this control has changed
         End If
       End If
     Case Else
   End Select
Next ctl

HTH

 

[Micron]

I put in the paragraph that it shows when going to a new record or when exiting out of the form.

I've looked 3x and cannot see where you've indicated what line in what procedure it fails on. Maybe
Screen.ActiveForm.Controls(IDField) should be Screen.ActiveForm.Controls("IDField") as I've never seen a .Controls("myControl") style of reference that worked without quotes.

 

[JonXL]

Maybe Screen.ActiveForm.Controls(IDField) should be Screen.ActiveForm.Controls("IDField") as I've never seen a .Controls("myControl") style of reference that worked without quotes.

It looks like it's a variable:

Sub AuditChanges(IDField As String, UserAction As String)

 

[Micron]

I agree because it's defined in the function as such. However, I think it would be = Screen.ActiveForm.Controls(" ' " & IDField & " ' ")
(I have included extra spaces so the single quotes can be seen easier)
or similar. I've used the Controls collection syntax before with variables and it required concatenation. Maybe not exactly as I have it, but similar.

 

[geospatial]

I've looked 3x and cannot see where you've indicated what line in what procedure it fails on. Maybe
Screen.ActiveForm.Controls(IDField) should be Screen.ActiveForm.Controls("IDField") as I've never seen a .Controls("myControl") style of reference that worked without quotes.

Sorry I misunderstood what you were asking originally, which is what my response was to. It is not showing me what line. I am guessing that has to do with the error handling that was put in the code. I will try and comment those out for the time being and see if it will reload with the debug mode.

 

[geospatial]

It looks like it fails at

If Nz(ctl.Value) <> Nz(ctl.OldValue) Then