Option Compare Database
Option Explicit

'// module with error handling functions
    ' Purpose: Generic error handler.
    ' Logs errors to table "ErrorLog".
    ' Arguments: lngErrNumber - value of Err.Number
    ' strErrDescription - value of err.description
    ' strLine - code line number (Erl) Erl=0 if no row number in the line
    ' strCallingProc - name of sub|function that generated the error.
    ' strCallingModule - name of code module that generated the error.
    ' vParameters - optional string: List of parameters to record.
    ' bShowUser - optional boolean: If False, suppresses display.
Function LogError(ByVal lngErrNumber As Long, ByVal strErrDescription As String, strLine As String, _
                  strCallingProc As String, Optional strCallingModule As String, Optional vParameters = "{Missing}", Optional bShowUser As Boolean = True) As Boolean
    On Error GoTo Err_LogError
    Dim strMsg As String                              ' String for display in MsgBox
    Dim rst    As DAO.Recordset                       ' The Aph_tblErrorLog table
    Select Case lngErrNumber
        Case 0
            Debug.Print strCallingProc & " called error 0."
        Case 2501                                     ' Cancelled
            'Do nothing.
'        Case 3314, 2101, 2115                         ' Can't save.
'            If bShowUser Then
'                strMsg = "Record cannot be saved at this time." & vbCrLf & "Complete the entry, or press <Esc> to undo."
'                MsgBox strMsg, vbExclamation, "Error"
'            End If
        Case Else
            If bShowUser Then
                strMsg = "Error " & lngErrNumber & ": " & strErrDescription & vbCrLf & "in " & _
                strCallingProc & " of " & strCallingModule & " at " & strLine
                Interaction.MsgBox strMsg, vbExclamation, "Error " & Now()
            End If
            'log the error to database
            Set rst = CurrentDb.OpenRecordset("tbl_BMS_ErrorLog", , dbAppendOnly)
            rst.AddNew
            rst![ErrorNum] = lngErrNumber
            rst![ErrorDescription] = Left$(strErrDescription, 255)
            rst![ErrLine] = strLine
            rst![CallingProc] = strCallingProc
            rst![Module] = strCallingModule
            rst![CreatedTimeStamp] = Now()
            rst![UserName] = GetCurrentUserID()
            If Not IsMissing(vParameters) Then
                rst![Parameters] = Left(vParameters, 255)
            End If
            rst.Update
            rst.Close
            LogError = True
    End Select

Exit_LogError:
    Set rst = Nothing
    Exit Function
Err_LogError:
    strMsg = "An unexpected situation arose in your program." & vbCrLf & _
             "Please write down the following details:" & vbCrLf & vbCrLf & _
             "Calling Proc: " & strCallingProc & vbCrLf & _
             "Error Number " & lngErrNumber & " in line " & strLine & vbCrLf & strErrDescription & vbCrLf & vbCrLf & _
             "Unable to record because Error " & Err.Number & " in line " & Erl & vbCrLf & Err.Description
    Interaction.MsgBox strMsg, vbCritical, "LogError()"
    Resume Exit_LogError
End Function