'---------------------------------------------------------------------------------------
' Procedure : ErrorLog
' DateTime : 11/01/2007 14:22
' Author : darth vodka
' Purpose : Writes an error log into the error table, called from all procedures
'---------------------------------------------------------------------------------------
'
Sub ErrorLog(lngErrorNumber As Long, _
strErrorDesc As String, _
strModule As String, _
strProcedure As String)
Const strErrorTable As String = "tbl_ErrorLog"
Dim strSQL As String
Dim StrErrText As String
Dim strTitle As String
On Error GoTo ErrorPlace
strTitle = vbNullString
strTitle = "Error Notification (" & strProcedure & ")"
StrErrText = vbNullString
StrErrText = StrErrText & "The following error occurred..."
StrErrText = StrErrText & vbCrLf & vbCrLf
StrErrText = StrErrText & "Error Number: " & CStr(lngErrorNumber)
StrErrText = StrErrText & vbCrLf
StrErrText = StrErrText & "Error Description: " & strErrorDesc
StrErrText = StrErrText & vbCrLf & vbCrLf
StrErrText = StrErrText & "In the procedure: " & strProcedure
StrErrText = StrErrText & vbCrLf & vbCrLf
StrErrText = StrErrText & "In the module: " & strModule
'MsgBox StrErrText, vbOKCancel, StrTitle
strSQL = "INSERT INTO " & strErrorTable & " ( nbkid, ErrorNumber, ErrorDescription, ErrorTime, [Module], [Procedure],[Database] ) "
strSQL = strSQL & " SELECT """ & NetworkID() & """, "
strSQL = strSQL & lngErrorNumber & ", """
strSQL = strSQL & strErrorDesc & """, #"
strSQL = strSQL & Format(Now(), "mm/dd/yyyy hh:mm:ss") & "#, """
strSQL = strSQL & strModule & """, """
strSQL = strSQL & strProcedure & """, """
strSQL = strSQL & CurrentDb.Name & """ ;"
With DoCmd
.SetWarnings (False)
.Hourglass (True)
.RunSQL strSQL
.SetWarnings (True)
.Hourglass (False)
End With
MsgBox "An error '" & strErrorDesc & "' occurred in some code, things may not have run completely"
Exit Sub
ErrorPlace:
'funnily enough you can *still* get errors here. e.g. you have no permissions to write to the errotable
'MsgBox "Error in creating ErrorLog: " & Err.Description
MsgBox "An error occurred in some code, things may not have run completely"
DoCmd.SetWarnings (True)
DoCmd.Hourglass (False)
End Sub