Global error handler with stack tracing

[dee-u]

This is just a sample of how to use a global error handler that will log application errors together with a stack tracing implementation.

These are the main functions that does the logging.

Public Function PromptAndLogError(ByVal strErrorSource As String, Optional ByVal strOtherInfo As String = vbNullString, Optional ByVal ReplyButton As Long = 2) As Long
    Dim strErrorMessage As String
    Dim strMsg          As String
    Dim strStack        As String
    Dim strErrDesc      As String
    Dim strErrNum       As String
    Dim strErl          As String
    Dim dteErrorOccured As Date
        
    'store the pertinent error values
    strErrDesc = Err.Description
    strErrNum = Err.Number
    strErl = Erl
    
    dteErrorOccured = Now 'get date
    strStack = GetTraces  'get stack trace
    
    strErrorSource = ProgramName & "." & strErrorSource
    
    If Len(strStack) > 0 Then
        strErrorMessage = "Last Trace:        " & strStack & vbCrLf
    End If
    'this will be the logged message, it will contain the stack trace
    strErrorMessage = strErrorMessage & _
                    "Error Occured In:  " & strErrorSource & vbCrLf & _
                    "Error Date & Time: " & dteErrorOccured & vbCrLf & _
                    "Error Description: " & strErrDesc & vbCrLf & _
                    "Error Number:      " & strErrNum & vbCrLf & _
                    "Line Number:       " & strErl
 
    'save other pertinent data that you want to be logged
    If Len(strOtherInfo) > 0 Then
        strErrorMessage = strErrorMessage & (vbCrLf & strOtherInfo)
    End If
    
    'this will be the message to be show to the user
    strMsg = "Error Occured In: " & strErrorSource & vbCrLf & _
             "Error Date & Time: " & dteErrorOccured & vbCrLf & _
             "Error Description: " & strErrDesc & vbCrLf & _
             "Error Number: " & strErrNum & vbCrLf & _
             "Line Number: " & strErl
    
    PromptAndLogError = LogAndProcessError(strMsg, strErrorMessage, dteErrorOccured, True, ReplyButton)
End Function
 
Private Function LogAndProcessError(ByVal MsgBoxError As String, ByVal ErrorMessage As String, ByVal dteErrorOccured As Date, Optional ShowPrompt As Boolean = True, Optional ByVal ReplyButton As Long = 2) As Long
        On Error GoTo HandleError
        
        Dim FileNum         As Integer
        Dim strErrorMessage As String
        Dim Response        As String
        Dim ErrorFile       As String
        Dim PCName          As String
        Dim ScreenFile      As String
        Dim strData         As String
        Dim ProgramPath     As String
        
100     SkipTrace = True
102     ProgramPath = strAppData
        
        'also log error in event viewer
104     App.StartLogging "", vbLogToNT
106     App.LogEvent ErrorMessage, vbLogEventTypeError
    
        'get computer name
108     PCName = GetPCName
 
        'create directory where the error will be logged if the directory does not yet exist
110     If DirectoryExists(ProgramPath & "\ErrorLog\") = False Then
112         CreateFolder ProgramPath & "\ErrorLog\"
        End If
        
        'this will create a unique file for each day
114     ErrorFile = ProgramPath & "\ErrorLog\ErrorLog-" & PCName & "-" & Format$(dteErrorOccured, "mmddyyyy") & ".txt"
116     ScreenFile = ProgramPath & "\ErrorLog\ErrorLog-" & PCName & "-" & Format$(dteErrorOccured, "mmddyyyy-hhnnss") & ".jpg"
        
118     If ShowPrompt = True Then
120         LogAndProcessError = MsgBox(MsgBoxError & vbCrLf & vbCrLf & "Please report to the programmer any persistent error.   ", vbCritical + ReplyButton + vbDefaultButton2, "Unexpected Error Encountered")
            'log also the response of the user
122         Select Case LogAndProcessError
            Case vbAbort
124             Response = "vbAbort"
126         Case vbRetry
128             Response = "vbRetry"
130         Case vbIgnore
132             Response = "vbIgnore"
134         Case vbOK
136             Response = "vbOK"
            End Select
138         If Len(Response) > 0 Then
140             ErrorMessage = ErrorMessage & vbNewLine & "Response:          " & Response
            End If
        End If
    
        'if the log file already exist then append the new error log
142     If FileExists(ErrorFile) = True Then
144         strData = vbCrLf & String$(20, "-") & vbCrLf & ErrorMessage
        Else
146         strData = ErrorMessage
        End If
    
148     FileNum = FreeFile
150     Open ErrorFile For Append As FileNum
152     Print #FileNum, strData
154     Close FileNum
    
        'capture screenshot
156     Capture_Desktop ScreenFile
        
158     Busy False
160     SkipTrace = False
 
        Exit Function
HandleError:
    strErrorMessage = vbNewLine & _
             "Error Occured In:  " & "LogAndProcessError" & vbCrLf & _
             "Error Date & Time: " & dteErrorOccured & vbCrLf & _
             "Error Description: " & Err.Description & vbCrLf & _
             "Error Number:      " & Err.Number & vbCrLf & _
             "Line Number:       " & Erl
    LogMessage strErrorMessage
    Busy False
End Function

And for the stack tracing:

Public Sub PushStack(ByVal strProcedure As String)
    'when in error handling routine then don't register traces
    If SkipTrace = True Then Exit Sub
 
    If ArrayInit(Not colStacks) = False Then
        'initialized
        ReDim Preserve colStacks(0)
        colStacks(0) = strProcedure
    Else
        'increase size
        ReDim Preserve colStacks(UBound(colStacks) + 1)
        colStacks(UBound(colStacks)) = strProcedure
    End If
End Sub
 
Public Sub PopStack()
    If SkipTrace = True Then Exit Sub
 
    If ArrayInit(Not colStacks) = True Then
        If UBound(colStacks) = LBound(colStacks) Then
            Erase colStacks
        Else
            ReDim Preserve colStacks(UBound(colStacks) - 1)
        End If
    End If
End Sub

Sample usage:

Private Sub Command1_Click()
        PushStack "Form1.Command1_Click"
        On Error GoTo HandleError
    
        Dim a As Long
        Dim b As Long
        Dim c As Long
        
100     a = 0
102     b = 1
104     c = b / a 'division by zero
    
ExitProcedure:
        PopStack
        Exit Sub
HandleError:
        Select Case PromptAndLogError("Form1.Command1_Click")
        Case vbAbort
             GoTo ExitProcedure
        Case vbRetry
             Resume
        Case vbIgnore
             Resume Next
        Case Else
             SignalCriticalError Err.Description
             End
        End Select
End Sub

If you happen to use MZTools then this will be the template that you can use:

PushStack "{MODULE_NAME}.{PROCEDURE_NAME}"
   On Error GoTo HandleError

	{PROCEDURE_BODY}

ExitProcedure:
   PopStack
   Exit {PROCEDURE_TYPE}

HandleError:

	Select Case PromptAndLogError("{MODULE_NAME}.{PROCEDURE_NAME}")
        Case vbAbort
             GoTo ExitProcedure
        Case vbRetry
             Resume
        Case vbIgnore
             Resume Next
        Case Else
             SignalCriticalError Err.Description
             End
        End Select

Have a look at the attached project for a complete demo.

[Ellis Dee]

Mine is the same basic idea, also using a call stack. I kept it all as a single function in order to make interacting with it easier.

I attached a rudimentary sample "project" to demonstrate how it works. It's just a bas file, but if you double-click it to open in VB6 and then click Run it should work fine.

Public Const ErrorIgnore = vbObjectError + 513
Public Const ErrorNotice = vbObjectError + 514
Public Const ErrorData = vbObjectError + 515
Public Const ErrorFail = vbObjectError + 516
 
Public Enum ErrorHandlerActions
    eaEnter
    eaExit
    eaLog
    eaNotify
    eaRaise
    eaRoot
End Enum
 
' ErrorHandler()
' This function is designed to offer robust and flexible
' error handling with a minimum of impact to the bulk of
' your code. It allows you to handle errors in data
' modules, classes, or generic utilities seemlessly.
'
' Concept
' Use "On Error" trapping only in root-level functions
' (defined as any event procedure fired by a user
' interaction or timer control) and functions that require
' a close-down section, such as those that access a
' database or create objects. No other error trapping
' is required. (The root-level trapping will catch any
' subsequent errors down the call stack, so additional
' trapping would be redundant.)
'
' Requirements
' ErrorHandler() requires a public enumeration as follows:
'Public Enum ErrorHandlerActions
'    eaEnter
'    eaExit
'    eaLog
'    eaNotify
'    eaRaise
'    eaRoot
'End Enum
'
' Call Stack
' ErrorHandler() tracks the call stack as provided by you
' the programmer. Send the function/sub/property/method
' procedure name to ErrorHandler() as the first line of
' code in each procedure. You should include the module
' name as well; one simple idea is to define a private
' constant in all modules that contains the module name,
' and then add the function name in each individual call.
'
' Root-Level functions
' For root-level functions (which will have error trapping)
' add to the call stack using the eaRoot action. These are
' also the functions where user notification is handled by
' calling the eaNotify action in the error trapping
' routine. Note that the eaExit action (discussed later)
' isn't needed in root-level functions. For example:
'Public Sub List1_Click()
'On Error GoTo List1_ClickErr
'    ErrorHandler eaRoot, ModuleConstant & ".List1_Click"
'    ' Your code to process the event goes here
'
'List1_ClickExit:
'    Exit Sub
'
'List1_ClickErr:
'    ErrorHandler eaNotify
'    Resume List1_ClickExit
'End Sub
'
' For "standard" functions, defined as being neither root-
' level nor requiring a close-down section, manage the
' call stack by beginning and ending each function with
' the eaEnter and eaExit actions respectively. Like the
' eaRoot action, eaEnter requires the function name. Also
' remember that error trapping is unnecessary in standard
' functions. Example:
'Public Sub Refresh()
'    ErrorHandler eaEnter, ModuleConstant & ".Refresh"
'    ' Your code goes here
'    ErrorHandler eaExit
'End Sub
'
' In non-root-level functions that require a close-down
' section, include eaEnter and eaExit actions just like
' with standard functions, but there is additional support
' required. Your error trapping that forces a close-down
' section (releasing objects or closing recordsets) to fire
' will absorb the actual error, leaving nothing to pass
' back up the call stack for ErrorHandler() to use in
' notifying the user. This problem is made worse because
' errors are typically suppressed (via On Error Resume
' Next) during close-down sections.
'
' ErrorHandler() provides a simple solution for this
' dilemma. Send the eaLog action in the error trapping
' routine to log the error for later use. In your close-
' down code, after it is finished be sure error trapping
' is re-enabled (with On Error Goto 0) and send the
' eaRaise action to propagate the error back up the call
' stack. Here is a complete example:
'Public Function GetEmployeeName() As String
'On Error GoTo GetEmployeeNameErr
'    ErrorHandler eaEnter, ModuleConstant & ".GetEmployeeName"
'    ' Your code to access data/create objects goes here
'    ErrorHandler eaExit
'
'GetEmployeeNameExit:
'    On Error Resume Next
'    ' Your code to close recordsets/objects goes here
'    On Error GoTo 0
'    ErrorHandler eaRaise
'    Exit Function
'
'GetEmployeeNameErr:
'    ErrorHandler eaLog
'    Resume GetEmployeeNameExit
'End Function
'
' Custom errors
' Your program will no doubt either have custom errors, or
' at least specific custom messages to some default errors.
' Modify the Select Case statement to handle your specific
' errors as appropriate.
'
' Action Summary
' eaEnter
'     Requires a source name. (Class/Module.Function)
'     Used at start of all non-root-level functions.
' eaExit
'     No source name required.
'     Used at end of all non-root-level functions.
' eaLog
'     No source name required.
'     Used in error trapping routine when a close-down
'     section is required. (Function uses data or objects.)
' eaNotify
'     No source name required.
'     Used in error trapping routine of root-level functions.
' eaRaise
'     No source name required.
'     Used at end of close-down sections.
' eaRoot
'     Requires a source name. (Class/Module.Function)
'     Used at start of all root-level functions.
Public Sub ErrorHandler(penAction As ErrorHandlerActions, Optional pstrSource As String)
    Const Delimiter = vbCrLf & "    "
    Static slngNumber As Long
    Static sstrSource As String
    Static sstrDescription As String
    Static sstrCallStack As String
    Dim strMessage As String
    Dim strDetail As String
    
    ' Clear error state if entering a root function
    If penAction = eaRoot Then
        Err.Clear
        slngNumber = 0
        sstrSource = ""
        sstrDescription = ""
        sstrCallStack = ""
    End If
    ' Remove source from list if successfully exiting a function
    If penAction = eaExit Then
        If InStr(sstrCallStack, Delimiter) > 0 Then
            sstrCallStack = Left(sstrCallStack, InStrRev(sstrCallStack, Delimiter, Len(sstrCallStack) - 1) - 1)
        End If
        Exit Sub
    End If
    ' Log source
    If penAction = eaRoot Or penAction = eaEnter Then
        sstrCallStack = sstrCallStack & Delimiter & pstrSource
    End If
    ' Log error number and description if in an error state
    If Err.Number <> 0 Then ' If penAction = eaLog Or penAction = eaNotify Then
        slngNumber = Err.Number
        sstrSource = Err.Source
        sstrDescription = Err.Description
    End If
    ' Raise error
    If penAction = eaRaise And slngNumber <> 0 Then
        Err.Raise slngNumber, sstrSource, sstrDescription
    End If
    ' Notify user
    If penAction = eaNotify And slngNumber <> 0 Then
        ' Update the screen
        Screen.MousePointer = vbNormal
        'UnlockWindow
        strDetail = _
            "Number: " & slngNumber & " (" & slngNumber - vbObjectError & ")" & vbCrLf & _
            "Source: " & sstrSource & vbCrLf & _
            "Description: " & sstrDescription & vbCrLf & vbCrLf & _
            "Call stack:" & sstrCallStack
        ' Show message
        Select Case slngNumber
            Case ErrorIgnore
            Case ErrorNotice
                MsgBox sstrDescription, vbInformation, "Notice"
            Case Else ' Unexpected error
                strMessage = sstrDescription & vbCrLf & vbCrLf & "View detail?"
                If MsgBox(strMessage, vbYesNo + vbInformation + vbDefaultButton2, "Notice") = vbYes Then
                    Clipboard.Clear
                    Clipboard.SetText strMessage, vbCFText
                    strDetail = strDetail & vbCrLf & vbCrLf & "Detail has been copied to the clipboard."
                    MsgBox strDetail, vbExclamation, "Error Detail"
                End If
        End Select
    End If
    ' Clear error state
    If penAction = eaNotify Then
        Err.Clear
        slngNumber = 0
        sstrCallStack = ""
        sstrDescription = ""
        sstrSource = ""
    End If
End Sub

[dee-u]

Hi Ellis Dee, your root-level function has got my attention. I have read this tip and considering modifying my implementation to the recommendation given, I want to ask if do you consider an "event handler" a root-level function?

[Ellis Dee]

Yes, that's exactly what a root level function is. Looks like I stumbled upon the same idea as the linked article recommends, though I see no point in adding error handling outside of root level functions other than functions where you have to close objects or database connections.

Had I been more thoughtful, "event handlers" would have been a much more descriptive name instead of "root level functions." They are the same thing. The easiest way to think of them is that they're always the root entry in a call stack. (Thus the name I picked.)

[Ellis Dee]

From the linked article:

Imagine you have opened a file and are attempting to roll back in your error handler. How do you know whether or not you opened the file? In other words, did the error occur before or after the line of code that opens the file? If you attempt to close the file and it's not open, you'll cause an error-but if it's open, you don't want to leave it open as you're trying to roll back! I guess you could use Erl to determine where your code erred, but this implies that you're editing line numbered source code-yuck. (You'll recall from Tip 2 that we added line numbers only to the code for the final EXE, not to the code we're still editing.) Probably the best way to determine what did or did not get done is to limit the possibilities; that is, keep your routines small (so that you have only a small problem domain). Of course, that's not going to help us here. What we need to do is apply a little investigation!

I don't seem to have these issues with my implementation. This type of function would be what I call a non-root function that needs to close objects. So it would go like this:

Public Function ReadFile() As String
On Error GoTo ReadFileErr
    Dim lngFileNumber As Long

    ErrorHandler eaEnter, ModuleConstant & ".ReadFile"
    ' Your code to access data/create objects goes here
    lngFileNumber = FreeFile()
    ' Open file and do stuff here
    ErrorHandler eaExit

ReadFileExit:
    On Error Resume Next
    Close lngFileNumber
    On Error GoTo 0
    ErrorHandler eaRaise
    Exit Function

ReadFileErr:
    ErrorHandler eaLog
    Resume ReadFileExit
End Function

Also from the linked article:

If you've cleaned up locally all the way through the call chain and if you had an error handler for each stack frame (so that you didn't jump over some routines), you should now have effectively rolled back from the error.

I see no point in trapping errors down the call stack that have no cleanup requirements. In other words, why would it be a problem to jump over routines that didn't need to close files or release objects? I don't get it.

Every function has the Enter and Exit calls in order to track the call stack, but why would actual trapping be required?