modError

Option Compare Database

Option Explicit

Public Const glHANDLED_ERROR As Long = 9999

Public Const glUSER_CANCEL As Long = 18

Public gstrERROR_LOG_PATH As String

Public gbDEBUG_MODE As Boolean

Private Const msSILENT_ERROR As String = "UserCancel"

Private Const msFILE_ERROR_LOG As String = "Error.log"

Public Sub SetErrorFilePath(strPath As String)

'test if folder exists

If Len(strPath) = 0 Then Exit Sub

If Right$(strPath, 1) = "\" Then strPath = Left(strPath, Len(Trim(strPath)) - 1)

gstrERROR_LOG_PATH = strPath

End Sub

Public Function bCentralErrorHandler(ByVal sModule As String, _

    ByVal sProc As String, _

    Optional ByVal sSourceFileName As String, _

    Optional ByVal bEntryPoint As Boolean, _

    Optional ByVal strSeverityCode = "L") As Boolean

 'SeverityCode can be the following values

 'L:low -will use vbInformation icon

 'H: high/critical -will use vbCritical icon

Static sErrMsg As String

Dim iFile As Integer    'file handle

Dim lErrNum As Long

Dim sPath As String

Dim sLogText As String

Dim sFullSource As String

Dim strUserID As String

lErrNum = Err.Number

If lErrNum = glUSER_CANCEL Then sErrMsg = msSILENT_ERROR

If Len(sErrMsg) = 0 Then sErrMsg = Err.Description

'no error allowed here

On Error Resume Next

If Len(sSourceFileName) = 0 Then sSourceFileName = CurrentProject.Name

'get the app directory

If Len(gstrERROR_LOG_PATH) > 0 Then

    sPath = AddBS(gstrERROR_LOG_PATH)

Else

    sPath = AddBS(getAppPath())

End If

'construct the fully-qualified error source name

sFullSource = "[" & sSourceFileName & "]" & sModule & "." & sProc

'error to be logged

sLogText = "  " & sFullSource & ", Error " & CStr(lErrNum) & ":" & sErrMsg & _

    " - " & strSeverityCode

'write the error text to a log file

iFile = FreeFile()

Open sPath & msFILE_ERROR_LOG For Append As #iFile

strUserID = getWindowsUserId()

Print #iFile, Format$(Now(), "mm/dd/yy hh:mm:ss"); ","; strUserID; ","; CStr(lErrNum); ","; sLogText

If bEntryPoint Then Print #iFile,

Close #iFile

'suppress silent errors

If sErrMsg <> msSILENT_ERROR Then

    If bEntryPoint Or gbDEBUG_MODE Or UCase$(strSeverityCode) = "H" Then

        'Application.ScreenUpdating = False

        MsgBox sErrMsg, vbCritical, sModule & "." & sProc

        'clear the static error message variable once

        'we've reach the entry point so that we're ready to handle the next erro

        sErrMsg = vbNullString

    End If

    bCentralErrorHandler = gbDEBUG_MODE

Else

    If bEntryPoint Then sErrMsg = vbNullString

    bCentralErrorHandler = False

End If

End Function