Error 13 | Audit Log

[Kaloyanides]

I was able to get the following AuditTrail module working but it throws an error. Type mismatch 13.

I can't seem to figure out what's causing the error?

Sorry if I posted too much info...

Any help greatly appreciated. Thanks so much.

frmContacts (Changed LastName and error fired)

tblContacts

Audit table

Record Changes

Option Compare Database

Const cDQ As String = """"

Sub AuditTrail(frm As Form, RecordID As Control)
'Track changes to data.
'recordid identifies the pk field's corresponding
'control in frm, in order to id record.
Dim ctl As Control
Dim varBefore As Variant
Dim varAfter As Variant
Dim strControlName As String
Dim strSQL As String
On Error GoTo ErrHandler
'Get changed values.
For Each ctl In frm.Controls
With ctl
'Avoid labels and other controls with Value property.
If .ControlType = acTextBox Then
If .Value <> .OldValue Then
varBefore = .OldValue
varAfter = .Value
strControlName = .NAME
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "Audit (EditDate, User, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
& cDQ & DLookup("UserName", "qryCurrentUser") & cDQ & ", " _
& cDQ & RecordID.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .NAME & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
End If
End With
Next
Set ctl = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description & vbNewLine _
& Err.NUMBER, vbOKOnly, "Error"
End Sub

Form_BeforeUpdate
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim rst As DAO.Recordset, strNames As String

On Error Resume Next
Call AuditTrail(Me, ContactID)

On Error GoTo Error_Handler
'Record Locking Feature and EnteredOn, UpdatedOn Fields
Call StampRecord(Me, False)

If Me.FirstName & "" = "" Then
MsgBox "You must enter a first name! Click Cancel to close without saving...", vbOKOnly + vbExclamation + vbDefaultButton2, "Attention!"
Cancel = True
Err.Clear
Me.FirstName.SetFocus
Exit Sub
End If
If Me.cboContactType & "" = "" Then
MsgBox "You must enter or select a contact type! Click Cancel to close without saving...", vbOKOnly + vbExclamation + vbDefaultButton2, "Attention!"
Cancel = True
Err.Clear
Me.cboContactType.SetFocus
Me.cboContactType.Dropdown
Exit Sub
End If
If Me.cboContactType = "Employee" Then
If Me.EmployeeNumber & "" = "" Then
MsgBox "You must enter an Employee Number! Click Cancel to close without saving...", vbOKOnly + vbExclamation + vbDefaultButton2, "Attention!"
Cancel = True
Err.Clear
Me.EmployeeNumber.SetFocus
Exit Sub
End If
End If

' If on a new row,
If (Me.NewRecord = True) Then
' Check for similar name
If Not IsNothing(Me.LastName) Then
' Open a recordset to look for similar names
Set rst = CurrentDb.OpenRecordset("SELECT LastName FROM " & _
"tblContacts WHERE Soundex([LastName]) = '" & _
Soundex(Me.LastName) & "'")
' If got some similar names, issue warning message
Do Until rst.EOF
strNames = strNames & rst!LastName & vbCrLf
rst.MoveNext
Loop
' Done with the recordset
rst.Close
Set rst = Nothing
' See if we got some similar names
If Len(strNames) > 0 Then
' Yup, issue warning
If vbNo = MsgBox("The System found contacts with similar " & _
"last names already saved in the database: " & vbCrLf & vbCrLf & _
strNames & vbCrLf & "Are you sure this contact is not a duplicate?", _
vbQuestion + vbYesNo + vbDefaultButton2, "Question?") Then
' Cancel the save
Cancel = True
End If
End If
End If
End If

Exit_Procedure:
On Error Resume Next
Exit Sub

Error_Handler:
MsgBox "An error has occurred in this application." & Err & ", " & Error & vbCrLf & vbCrLf & _
"Please contact your technical support person and report the problem.", vbExclamation, "Error!"
ErrorLog Me.NAME & "_Form_BeforeUpdate", Err, Error
' Put the focus back in the database window
DoCmd.SelectObject acTable, "ErrorLog", True
Resume Exit_Procedure
End Sub

 

[The_Doc_Man]

Error 13 is a run-time error. If you don't have warnings disabled, you should get TWO things of importance. One of them, you informed us, is that you got the Error 13 pop-up. But if debugging is enabled (and in this case, it SHOULD be enabled), you should also get the VBA screen to open up and show the miscreant line in yellow. Knowing which line it was would make fixing it so easy. And to be honest, you really DID post more info than was helpful here because it is like a cloud of info fog reducing visibility.

If you can come back with the erroneous line, that plus your original post would make this a LOT simpler.

 

[Kaloyanides]

This is where the error is:

I'm only changing the last name field to test this function. It's an indexed text box (duplicates okay) limited to 50 (field size.)

 

[jdraw]

Can you post a copy of your test database?

 

[The_Doc_Man]

When you get that error, hover the mouse cursor over .Value and .OldValue (in the highlighted line) so that you can see what is in each. That might give you a hint as to why this error occurs.