Here's the error handling. It involves some constants that I lifted from a separate constants module. A table is required for the errors, so either create it based on fields listed in routine or turn of "log in table" and just log in a text file.
[tt]
Public Const APPLICATION_NAME As String = "InsightDeveloperLibrary"
Public Const CRITICAL_ALERT As String = vbCrLf & vbCrLf & "Please Contact Insight Data Consulting"
'---------------------------------------------------
'Error Message for global use
Public Const BLN_CRITICAL As Boolean = True
Public Const ERROR_ALERT As String = "An error occurred"
Public Const ERROR_LOGGED_ALERT As String = "An error occured and has been logged"
'Refers to error generated when DoCmd cancelled
Public Const ACTION_CANCELLED As Long = 2501
'Data Error Constants
Public Const DUPLICATE_INDEX As Long = 3022
Public Const NULL_KEY_FIELD As Long = 3058
Public Const WRITE_CONFLICT As Long = 3197
Public Const RECORD_LOCKED As Long = 3260
Public Const NON_DATE As Long = 2113
Public Const LINK_FAILED As Long = 7971
Public Const NOT_IN_LIST As Long = 2237
Public Const NULL_REQUIRED_FIELD As Long = 3314
Public Const CHILD_RECORD As Long = 3200
Public Sub RespondToError(ByVal v_strRoutine As String, ByVal p_ErrorNum As Long, _
ByVal p_strErrorMsg As String, Optional p_Response As String, Optional p_Critical As Boolean)
On Error GoTo Error_RespondToError
Const DEFAULT_ERROR_MESSAGE As String = "An error occurred and has been logged"
Dim strResponse As String
Dim MessageClass As Long
MessageClass = vbInformation
If Len(p_Response) Then
strResponse = p_Response
If p_Critical Then
MessageClass = vbCritical
End If
Else
strResponse = DEFAULT_ERROR_MESSAGE
End If
Select Case p_ErrorNum
Case ACTION_CANCELLED
'Do nothing
Case CHILD_RECORD
MsgBox "Parent record may not be deleted with related records in place" & _
vbCrLf & "Use the ""DELETE"" buttons in the subform", vbExclamation, _
APPLICATION_NAME
Case Else
MsgBox strResponse, MessageClass, APPLICATION_NAME
LogError v_strRoutine, p_ErrorNum, p_strErrorMsg
End Select
Exit_RespondToError:
Exit Sub
Error_RespondToError:
MsgBox "Error Response Failed" & CRITICAL_ALERT, vbCritical, APPLICATION_NAME
Resume Exit_RespondToError
End Sub 'RespondToError
Public Sub LogError(ByVal v_strRoutine As String, ByVal v_lngErrorNum As Long, _
ByVal v_strErrorDescription As String)
On Error GoTo Error_LogError
LogErrorInTable v_strRoutine, v_lngErrorNum, v_strErrorDescription
LogErrorInTextFile v_strRoutine, v_lngErrorNum, v_strErrorDescription
Exit_LogError:
Exit Sub
Error_LogError:
MsgBox "Error Logging Failed" & CRITICAL_ALERT, vbCritical, APPLICATION_NAME
Resume Exit_LogError
End Sub
Public Sub LogErrorInTable(ByVal v_strRoutine As String, ByVal v_lngErrorNum As Long, _
ByVal v_strErrorDescription As String)
'*Requires tbl_ErrorLog
On Error GoTo Error_LogErrorInTable
Dim DB As DAO.Database
Set DB = CurrentDb()
Dim strSQL_INSERT As String
Dim strUser As String
Dim strObject As String
Dim strSQL_CREATE As String
strUser = apiUserName
strObject = Application.CurrentObjectName
strSQL_INSERT = "insert into error_log " & _
"(user, current_object, routine, error_number,error_description, error_timestamp) " & _
"values (" & _
Chr(39) & strUser & Chr(39) & "," & _
Chr(39) & strObject & Chr(39) & "," & _
Chr(39) & v_strRoutine & Chr(39) & "," & _
v_lngErrorNum & "," & _
Chr(39) & v_strErrorDescription & Chr(39) & "," & _
Chr(35) & Now() & Chr(35) & ")"
DB.Execute strSQL_INSERT
Exit_LogErrorInTable:
Set DB = Nothing
Exit Sub
Error_LogErrorInTable:
MsgBox "Error Logging Failed" & CRITICAL_ALERT, vbCritical, APPLICATION_NAME
Resume Exit_LogErrorInTable
End Sub 'LogErrorInTable
Public Sub LogErrorInTextFile(ByVal v_strRoutine As String, ByVal v_lngErrorNum As Long, _
ByVal v_strErrorDescription As String)
On Error GoTo Error_LogErrorInTextFile
Dim intFile As Integer
Dim strErrMessage As String
Dim strPath As String
Dim strErrorFile As String
Dim strPrompt As String
Dim strUser As String
strPath = CurrentProject.Path
strErrorFile = APPLICATION_NAME & "_error_log.txt"
strUser = apiUserName
strErrMessage = vbCrLf & "Error logged: " & Format(Now(), "mmm-dd-yy hh:mm AM/PM") & vbCrLf & _
"User: " & strUser & vbCrLf & "Routine: " & v_strRoutine & vbCrLf & "ErrorNum: " & _
CStr(v_lngErrorNum) & vbCrLf & "Description: " & v_strErrorDescription & vbCrLf
intFile = FreeFile
'File will be created if not found
Open strErrorFile For Append As #intFile
Print #intFile, strErrMessage
Close #intFile
Exit_LogErrorInTextFile:
Exit Sub
Error_LogErrorInTextFile:
MsgBox "Error Logging Failed" & CRITICAL_ALERT, vbCritical, APPLICATION_NAME
Resume Exit_LogErrorInTextFile
End Sub 'LogError
Public Function DataErrorResponse(ByVal v_ErrorNum As Integer) As Integer
On Error GoTo Error_LogDataError
Dim strResponse As String
Dim strError As String
strResponse = "A data error has occurred:" & vbCrLf & vbCrLf
Select Case v_ErrorNum
Case DUPLICATE_INDEX
strError = "You've attempted to enter a duplicate value where not allowed" & _
vbCrLf & "Remove or change the duplicate selection or Cancel"
Case NULL_KEY_FIELD
strError = strError = "An entry is missing for a required field" & _
vbCrLf & "Make sure that there are values in fields that are underlined"
Case WRITE_CONFLICT
strError = "Another user is attempting to update the same record-try to save again in a few minutes" & _
vbCrLf & "Use Cancel button to cancel the entry if needed"
Case RECORD_LOCKED
strError = "Another user is attempting to update the same record-try to save again in a few minutes" & _
vbCrLf & "Use Cancel button to cancel the entry if needed"
Case NON_DATE
strError = "The data entered does not match the field datatype--be sure to enter a date"
Case LINK_FAILED
strError = "The hyperlink is not valid"
Case NOT_IN_LIST
strError = "The field is limited to existing entries only" & _
vbCrLf & "Choose a value from the list"
Case NULL_REQUIRED_FIELD
strError = "An entry is missing for a required field" & _
vbCrLf & "Make sure that there are values in fields that are underlined"
Case Else
strError = "Error Number: " & CStr(v_ErrorNum)
End Select
LogError "Data Error", v_ErrorNum, "Data Error"
strResponse = strResponse & strError
MsgBox strResponse, vbExclamation, APPLICATION_NAME
DataErrorResponse = acDataErrContinue
Exit_LogDataError:
Exit Function
Error_LogDataError:
Resume Exit_LogDataError
End Function 'DataErrorResponse
[/tt]
Jeff Roberts
Insight Data Consulting
Access and SQL Server Development