Excel VBA Global error handling

Question

Is there a way to do global error handling?

Can I put some code in the Workbook code that will catch any errors that occur within all modules?

I could put th

Answer 1

As Sid already mentioned in the comment, there is no central error handler.

Best practice is to have a central error handling routine that gets called from the local error handlers. Take a look at the great MZ-Tools: it has the possibility to define a default error handler at the press of a button (Ctrl-E). You can customize this error handler - and it can also contain module and/or sub name!

Additionally, check out this post at Daily Dose of Excel. It is Dick Kusleika's OO version of the error handler proposed in this book (which I can highly recommend).

Answer 2

Here's some code I threw together to handle the problem in access

It puts error checking in all subs, but not functions. subs have to have a parent form (ACCESS), or alternatively, you have to put the form name in manually. subs that are continued over more than one line will be mercilessly whacked.

The two subs have to be at the bottom of a module.

• globalerror is your error management routine
• CleaVBA_click changes your VBA code, adds line #s to everything

globalerror looks at a boolean global errortracking to see if it logs everything or only errors

There is a table ErrorTracking that has to be created otherwise just comment out from 1990 to 2160

When running, it removes then adds line numbers to everything in the project, so your error message can include a line #

Not sure if it works on anything other than stuff I've coded.

Be sure to run and test on a copy of your VBA, because it literally rewrites every line of code in your project, and if I screwed up, and you didn't back up, then your project is broken.

    Public Sub globalerror(Name As String, number As Integer, Description As String, source As String)


    1970  Dim db As DAO.Database
    1980  Dim rst As DAO.Recordset



    1990  If errortracking Or (Err.number <> 0) Then
    2000     Set db = CurrentDb
    2010     Set rst = db.OpenRecordset("ErrorTracking")
    2020     rst.AddNew

    2030     rst.Fields("FormModule") = Name
    2040     rst.Fields("ErrorNumber") = number
    2050     rst.Fields("Description") = Description
    2060     rst.Fields("Source") = source
    2070     rst.Fields("timestamp") = Now()
    2080     rst.Fields("Line") = Erl

    2100     rst.Update
    2110     rst.Close
    2120     db.Close
    2130  End If

    2140  If Err.number = 0 Then
    2150     Exit Sub
    2160  End If

    2170  MsgBox "ERROR" & vbCrLf & "Location: " & Name & vbCrLf & "Line: " & Erl & vbCrLf & "Number: " & number & vbCrLf & "Description: " & Description & vbCrLf & source & vbCrLf & Now() & vbCrLf & vbCrLf & "custom message"

    2180  End Sub






    Private Sub CleanVBA_Click()

        Dim linekill As Integer
        Dim component As Object
        Dim index As Integer
        Dim str As String
        Dim str2a As String
        Dim linenumber As Integer
        Dim doline As Boolean
        Dim skipline As Boolean
        Dim selectflag As Boolean
        Dim numstring() As String


        skipline = False
        selectflag = False
        tabcounter = 0

        For Each component In Application.VBE.ActiveVBProject.VBComponents

            linekill = component.CodeModule.CountOfLines
            linenumber = 0
            For i = 1 To linekill

                str = component.CodeModule.Lines(i, 1)
                doline = True

                If Right(Trim(str), 1) = "_" Then
                    doline = False
                    skipline = True
                End If

                If Len(Trim(str)) = 0 Then
                    doline = False
                End If

                If InStr(Trim(str), "'") = 1 Then
                    doline = False
                End If

                If selectflag Then
                    doline = False
                End If

                If InStr(str, "Select Case") > 0 Then
                    selectflag = True
                End If

                If InStr(str, "End Select") > 0 Then
                    selectflag = False
                End If

                If InStr(str, "Global ") > 0 Then
                    doline = False
                End If

                If InStr(str, "Sub ") > 0 Then
                    doline = False
                End If

                If InStr(str, "Option ") > 0 Then
                    doline = False
                End If

                If InStr(str, "Function ") > 0 Then
                    doline = False
                End If


                If (InStr(str, "Sub ") > 0) Then


                    If InStr(component.CodeModule.Lines(i + 1, 1), "On Error GoTo error") <> 0 Then
                        GoTo skipsub
                    End If

                    str2a = component.CodeModule.Name

                    index = InStr(str, "Sub ")  ' sub
                    str = Right(str, Len(str) - index - 3)    ' sub

                    '           index = InStr(str, "Function ") ' function
                    '             str = Right(str, Len(str) - index - 8) 'function

                    index = InStr(str, "(")
                    str = Left(str, index - 1)

                    varReturn = SysCmd(acSysCmdSetStatus, "Editing: " & str2a & " : " & str)
                    DoEvents

                    If (str = "CleanVBA_Click") Then
                        MsgBox "skipping self"
                        GoTo selfie
                    End If

                    If str = "globalerror" Then
                        MsgBox "skipping globalerror"
                        GoTo skipsub
                    End If

                    component.CodeModule.InsertLines i + 1, "On Error GoTo error"
                    i = i + 1
                    linekill = linekill + 1

                    component.CodeModule.InsertLines i + 1, "error:"
                    i = i + 1
                    linekill = linekill + 1

                    component.CodeModule.InsertLines i + 1, "Call globalerror(Me.Form.Name & """ & "-" & str & """, Err.number, Err.description, Err.source)"
                    i = i + 1
                    linekill = linekill + 1

                    component.CodeModule.InsertLines i + 1, " "
                    i = i + 1
                    linekill = linekill + 1

                    If (str = "MashVBA_Click") Then
                        MsgBox "skipping self"
                        MsgBox component.CodeModule.Name & " " & str
                        GoTo selfie
                    End If
                Else
                    If skipline Then
                        If doline Then
                            skipline = False
                        End If
                        doline = False
                    End If
                    If doline Then
                        linenumber = linenumber + 10
                        numstring = Split(Trim(str), " ")
                        If Len(numstring(0)) >= 2 Then
                            If IsNumeric(numstring(0)) Then
                                str = Replace(str, numstring(0), "")
                            End If
                        End If
                        component.CodeModule.ReplaceLine i, linenumber & " " & str

                    End If

                End If
    skipsub:

            Next i
    selfie:
        Next

        varReturn = SysCmd(acSysCmdSetStatus, " ")
        MsgBox "Finished"
    End Sub