Automatically generating handling of issues
Asked Answered
O

6

20

This is more an observation than a real question: MS-Access (and VBA in general) is desperately missing a tool where error handling code can be generated automatically, and where the line number can be displayed when an error occurs. Did you find a solution? What is it? I just realized how many hundreds of hours I spared since I found the right answer to this basic problem a few years ago, and I'd like to see what are your ideas and solutions on this very important issue.

Oleson answered 10/12, 2008 at 22:24 Comment(2)
You do not want to use Line Numbers in your code. Read this: You don't want line numbersDomoniquedomph
Well noted, and agreed. I do not want line numbers. And I do not have any line numbers in my development code. Then, when it comes to the user's version of my apps, where I want to be able to log errors generated by users, I am adding them (in an automated way), making errors follow-up much easier: (1) at least I can check if errors coming from a specific module are indeed identical and (2) debugging the code is quicker. And, of course, I do not have any procedure with more than 65 000 lines!Oleson
O
7

My solution is the following:

  1. install MZ-Tools, a very interesting add-on for VBA. No they did not pay me to write this. Version 3 was free, but since version 8.0, the add-in is commercially sold.
  2. program a standard error handler code such as this one (see MZ-Tools menu/Options/Error handler):

On Error GoTo {PROCEDURE_NAME}_Error
{PROCEDURE_BODY}
On Error GoTo 0
Exit {PROCEDURE_TYPE}

{PROCEDURE_NAME}_Error:
debug.print "#" & Err.Number, Err.description, "l#" & erl, "{PROCEDURE_NAME}", "{MODULE_NAME}"

This standard error code can be then automatically added to all of your procs and function by clicking on the corresponding button in the MZ-Tools menu. You'll notice that we refer here to a hidden and undocumented function in the VBA standard library, 'Erl', which stands for 'error line'. You got it! If you ask MZ-Tools to automatically number your lines of code, 'Erl' will then give you the number of the line where the error occured. You will have a complete description of the error in your immediate window, such as:

#91, Object variable or With block variable not set, l# 30, addNewField, Utilities

Of course, once you realize the interest of the system, you can think of a more sophisticated error handler, that will not only display the data in the debug window but will also:

  1. display it as a message on the screen
  2. Automatically insert a line in an error log file with the description of the error or
  3. if you are working with Access or if you are connected to a database, automatically add a record to a Tbl_Error table!

meaning that each error generated at the user level can be stored either in a file or a table, somewhere on the machine or the network. Are we talking about building an automated error reporting system working with VBA?

Oleson answered 10/12, 2008 at 22:45 Comment(3)
Good post, but I am critical of the practice of having your error handler and exit routine not have a uniform name, e.g., errHandler and exitRoutine. Because of label scope there is no reason to make them specific to the particular sub. Makes cutting and pasting a helluva lot easier.Biathlon
You are right: no need to have a specific name for the error routine. But it doesn't really matter as you will not make copy/pastes from 1 proc to the other but rather use the "insert error code" button, that generates the needed lines according to predefined format.Oleson
On Error Goto 0 is an unnecessary line, since you're exiting the procedure in the next line. the On Error Goto ErrorHandler statement doesn't apply outside of the procedureEnabling
D
7

What about using "Erl", it will display the last label before the error (e.g., 10, 20, or 30)?

Private Sub mySUB()
On Error GoTo Err_mySUB
10:
    Dim stDocName As String
    Dim stLinkCriteria As String
20:
    stDocName = "MyDoc"
30:
    DoCmd.openform stDocName, acFormDS, , stLinkCriteria    
Exit_mySUB:
    Exit Sub
Err_mySUB:
    MsgBox Err.Number & ": " & Err.Description & " (" & Erl & ")"
    Resume Exit_mySUB
End Sub
Darling answered 10/12, 2008 at 22:47 Comment(0)
C
5

Well there are a couple of tools that will do what you ask MZ Tools and FMS Inc come to mind.

Basically they involve adding an:

On Error GoTo ErrorHandler

to the top of each proc and at the end they put an:

ErrorHandler:
  Call MyErrorhandler Err.Number, Err.Description, Err.LineNumber

label with usually a call to a global error handler where you can display and log custom error messages

Churlish answered 10/12, 2008 at 22:40 Comment(1)
This is slightly misleading as Err.LineNumber doesn't exist.. So while good practice for generic error handling, it doesn't answer the crux of the original issue about line numbering. If you need to do this then the answer involving Erl would be better if you had to have a line number.Bennink
D
3

There is no need to buy tools DJ mentioned. Here is my code for free:

Public Sub InsertErrHandling(modName As String)
    Dim Component As Object
    Dim Name As String
    Dim Kind As Long
    Dim FirstLine As Long
    Dim ProcLinesCount As Long
    Dim Declaration As String
    Dim ProcedureType As String
    Dim Index As Long, i As Long
    Dim LastLine As Long
    Dim StartLines As Collection, LastLines As Collection, ProcNames As Collection, ProcedureTypes As Collection
    Dim gotoErr As Boolean

    Kind = 0
    Set StartLines = New Collection
    Set LastLines = New Collection
    Set ProcNames = New Collection
    Set ProcedureTypes = New Collection

    Set Component = Application.VBE.ActiveVBProject.VBComponents(modName)
        With Component.CodeModule

            ' Remove empty lines on the end of the code
            For i = .CountOfLines To 1 Step -1
                If Component.CodeModule.Lines(i, 1) = "" Then
                  Component.CodeModule.DeleteLines i, 1
                Else
                    Exit For
                End If
            Next i

            Index = .CountOfDeclarationLines + 1
            Do While Index < .CountOfLines
                gotoErr = False
                Name = .ProcOfLine(Index, Kind)
                FirstLine = .ProcBodyLine(Name, Kind)
                ProcLinesCount = .ProcCountLines(Name, Kind)
                Declaration = Trim(.Lines(FirstLine, 1))
                LastLine = FirstLine + ProcLinesCount - 2
                If InStr(1, Declaration, "Function ", vbBinaryCompare) > 0 Then
                    ProcedureType = "Function"
                Else
                    ProcedureType = "Sub"
                End If
                Debug.Print Component.Name & "." & Name, "First: " & FirstLine, "Lines:" & ProcLinesCount, "Last: " & LastLine, Declaration
                Debug.Print "Declaration: " & Component.CodeModule.Lines(FirstLine, 1), FirstLine
                Debug.Print "Closing Proc: " & Component.CodeModule.Lines(LastLine, 1), LastLine

                ' do not insert error handling if there is one already:
                For i = FirstLine To LastLine Step 1
                    If Component.CodeModule.Lines(i, 1) Like "*On Error*" Then
                        gotoErr = True
                        Exit For
                    End If
                Next i
                If Not gotoErr Then
                    StartLines.Add FirstLine
                    LastLines.Add LastLine
                    ProcNames.Add Name
                    ProcedureTypes.Add ProcedureType
                End If

                Index = FirstLine + ProcLinesCount + 1
            Loop

            For i = LastLines.Count To 1 Step -1
                If Not (Component.CodeModule.Lines(StartLines.Item(i) + 1, 1) Like "*On Error GoTo *") Then
                    Component.CodeModule.InsertLines LastLines.Item(i), "ExitProc_:"
                    Component.CodeModule.InsertLines LastLines.Item(i) + 1, "    Exit " & ProcedureTypes.Item(i)
                    Component.CodeModule.InsertLines LastLines.Item(i) + 2, "ErrHandler_:"
                    Component.CodeModule.InsertLines LastLines.Item(i) + 3, "    Call LogError(Err, Me.Name, """ & ProcNames.Item(i) & """)"
                    Component.CodeModule.InsertLines LastLines.Item(i) + 4, "    Resume ExitProc_"
                    Component.CodeModule.InsertLines LastLines.Item(i) + 5, "    Resume ' use for debugging"

                    Component.CodeModule.InsertLines StartLines.Item(i) + 1, "    On Error GoTo ErrHandler_"
                End If
            Next i
        End With
End Sub

Put it in a module and call it from Immediate Window every time you add new function or sub to a form or module like this (Form1 is name of your form):

MyModule.InsertErrHandling "Form_Form1"

It will alter your ode in Form1 from this:

Private Function CloseIt()
    DoCmd.Close acForm, Me.Name
End Function

to this:

Private Function CloseIt()
    On Error GoTo ErrHandler_
        DoCmd.Close acForm, Me.Name
ExitProc_:
Exit Function
ErrHandler_:
    Call LogError(Err, Me.Name, "CloseIt")
    Resume ExitProc_
    Resume ' use for debugging
End Function

Create now in a module a Sub which will display the error dialog and where you can add inserting the error to a text file or database:

Public Sub LogError(ByVal objError As ErrObject, moduleName As String, Optional procName As String = "")
    On Error GoTo ErrHandler_
    Dim sql As String
    MsgBox "Error " & Err.Number & " Module " & moduleName & Switch(procName <> "", " in " & procName) & vbCrLf & " (" & Err.Description & ") ", vbCritical
Exit_:
    Exit Sub
ErrHandler_:
    MsgBox "Error in LogError procedure " & Err.Number & ", " & Err.Description
    Resume Exit_
    Resume ' use for debugging
End Sub

This code does not enter error handling if there is already "On Error" statement in a proc.

Domoniquedomph answered 10/2, 2019 at 18:13 Comment(2)
It would be great but sometimes it wouldn't work if we have On Error statements in our sub or function (overwrite added to beginning On Error GoTo ErrHandler_) so our error handling would be dead code.Ocampo
Maybe changing every On Error GoTo 0 to On Error GoTo ErrHandler_ would do the job, just wondering.Ocampo
P
2

You can always roll your own tool like Chip Pearson did. VBA can actually access it's own IDE via the Microsoft Visual Basic for Applications Extensibility 5.3 Library. I've written a few class modules that make it easier to work with myself. They can be found on Code Review SE.

I use it to insert On Error GoTo ErrHandler statements and the appropriate labels and constants related to my error handling schema. I also use it to sync up the constants with the actual procedure names (if the function names should happen to change).

Pyrrhonism answered 30/6, 2014 at 15:24 Comment(0)
N
1

Love it Vlado!

I realize this is an old post, but I grabbed it and gave it a try, but I ran into a number of issues with it, which I managed to fix. Here's the code with fixes:

First of course, be sure to add the "Microsoft Visual Basic for Applications Extensibility 5.3" library to your project, and add these subroutines / modules to your project as well.

First, the module with the main code was named "modVBAChecks", and contained the following two subroutines:

To go through all modules (behind forms, sheets, the workbook, and classes as well, though not ActiveX Designers):

Sub AddErrorHandlingToAllProcs()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim lCtr As Long

StartNewWorksheetLog

Set VBProj = Workbooks("LabViewAnalysisTools.xla").VBProject
For Each VBComp In VBProj.VBComponents
    If VBComp.Type <> vbext_ct_ActiveXDesigner Then
        If VBComp.Name <> "modVBAChecks" And VBComp.Name <> "modLogToWorksheet" Then
            AddToWksLog "============ Looking at Module """ & VBComp.Name & """"
            'InsertErrHandling VBComp.Name               
            AddToWksLog
            AddToWksLog
        End If
    End If
Next
MsgBox "Done!", vbSystemModal
End Sub

Then the modified version of your code (including a suggested change by
Rafał B.):

Public Sub InsertErrHandling(modsProcName As String)
    ' Modified from code submitted to StackOverflow by user Vlado, originally found
    ' here:  https://mcmap.net/q/622189/-automatically-generating-handling-of-issues
    
    Dim vbcmA As VBIDE.CodeModule
    Dim ProcKind As VBIDE.vbext_ProcKind
    Dim LineProcKind As VBIDE.vbext_ProcKind
    Dim sProcName As String
    Dim sLineProcName As String
    Dim lFirstLine As Long
    Dim lProcLinesCount As Long
    Dim lLastLine As Long
    Dim sDeclaration As String
    Dim sProcType As String
    Dim lLine As Long, lLine2 As Long
    Dim sLine As String
    Dim lcStartLines As Collection, lcLastlines As Collection, scProcsProcNames As Collection, scProcTypes As Collection
    Dim bAddHandler As Boolean
    Dim lLinesAbove As Long

    Set lcStartLines = New Collection
    Set lcLastlines = New Collection
    Set scProcsProcNames = New Collection
    Set scProcTypes = New Collection

    Set vbcmA = Application.VBE.ActiveVBProject.VBComponents(modsProcName).CodeModule
    
    ' Remove empty lines on the end of the module. Cleanup, not error handling. 
    lLine = vbcmA.CountOfLines
    If lLine = 0 Then Exit Sub ' Nothing to do!
    Do
        If Trim(vbcmA.Lines(lLine, 1)) <> "" Then Exit Do
        vbcmA.DeleteLines lLine, 1
        lLine = lLine - 1
    Loop

    lLine = vbcmA.CountOfDeclarationLines + 1
    Do While lLine < vbcmA.CountOfLines
        bAddHandler = False

        ' NOTE: ProcKind is RETRUNED from ProcOfLine!
        sProcName = vbcmA.ProcOfLine(lLine, ProcKind)
        
        ' Fortunately ProcBodyLine ALWAYS returns the first line of the procedure declaration!
        lFirstLine = vbcmA.ProcBodyLine(sProcName, ProcKind)
        sDeclaration = Trim(vbcmA.Lines(lFirstLine, 1))
        
        Select Case ProcKind
        Case VBIDE.vbext_ProcKind.vbext_pk_Proc
            If sDeclaration Like "*Function *" Then
                sProcType = "Function"
            ElseIf sDeclaration Like "*Sub *" Then
                sProcType = "Sub"
            End If
        Case VBIDE.vbext_ProcKind.vbext_pk_Get, VBIDE.vbext_ProcKind.vbext_pk_Let, VBIDE.vbext_ProcKind.vbext_pk_Set
            sProcType = "Property"
        End Select
        
        ' The "lProcLinesCount" function will sometimes return ROWS ABOVE 
        ' the procedure, possibly up until the prior procedure,
        ' and often rows BELOW the procedure as well!!!
                
        lProcLinesCount = vbcmA.ProcCountLines(sProcName, ProcKind)
        lLinesAbove = 0
        lLine2 = lFirstLine - 1
        If lLine2 > 0 Then
            Do
                sLineProcName = vbcmA.ProcOfLine(lLine2, LineProcKind)
                If Not (sLineProcName = sProcName And LineProcKind = ProcKind) Then Exit Do
                lLinesAbove = lLinesAbove + 1
                lLine2 = lLine2 - 1
                If lLine2 = 0 Then Exit Do
            Loop
        End If
        lLastLine = lFirstLine + lProcLinesCount - lLinesAbove - 1
        
        ' Now need to trim off any follower lines!
        Do
            sLine = Trim(vbcmA.Lines(lLastLine, 1))
            If sLine = "End " & sProcType Or sLine Like "End " & sProcType & " '*" Then Exit Do
            lLastLine = lLastLine - 1
        Loop
        
        AddToWksLog modsProcName & "." & sProcName, "First: " & lFirstLine, "Lines:" & lProcLinesCount, "Last: " & lLastLine
        AddToWksLog "sDeclaration: " & vbcmA.Lines(lFirstLine, 1), lFirstLine
        AddToWksLog "Closing Proc: " & vbcmA.Lines(lLastLine, 1), lLastLine

        If lLastLine - lFirstLine < 8 Then
            AddToWksLog " --------------- Too Short to bother!"
        Else
            bAddHandler = True
            ' do not insert error handling if there is one already:
            For lLine2 = lFirstLine To lLastLine Step 1
                If vbcmA.Lines(lLine2, 1) Like "*On Error GoTo *" And Not vbcmA.Lines(lLine2, 1) Like "*On Error GoTo 0" Then
                    bAddHandler = False
                    Exit For
                End If
            Next lLine2
            If bAddHandler Then
                lcStartLines.Add lFirstLine
                lcLastlines.Add lLastLine
                scProcsProcNames.Add sProcName
                scProcTypes.Add sProcType
            End If
        End If
        
        AddToWksLog
        
        lLine = lFirstLine + lProcLinesCount + 1
    Loop

    For lLine = lcLastlines.Count To 1 Step -1
        vbcmA.InsertLines lcLastlines.Item(lLine), "ExitProc:"
        vbcmA.InsertLines lcLastlines.Item(lLine) + 1, "    Exit " & scProcTypes.Item(lLine)
        vbcmA.InsertLines lcLastlines.Item(lLine) + 2, "ErrHandler:"
        vbcmA.InsertLines lcLastlines.Item(lLine) + 3, "    ShowErrorMsg Err, """ & scProcsProcNames.Item(lLine) & """, """ & modsProcName & """"
        vbcmA.InsertLines lcLastlines.Item(lLine) + 4, "    Resume ExitProc"
        ' Now replace any "On Error Goto 0" lines with "IF ErrorTrapping Then On Error Goto ErrHandler"
        For lLine2 = lcStartLines(lLine) To lcLastlines(lLine)
            sLine = vbcmA.Lines(lLine2, 1)
            If sLine Like "On Error GoTo 0" Then
                vbcmA.ReplaceLine lLine2, Replace(sLine, "On Error Goto 0", "IF ErrorTrapping Then On Error Goto ErrHandler")
            End If
        Next
        lLine2 = lcStartLines.Item(lLine)
        Do
            sLine = vbcmA.Lines(lLine2, 1)
            If Not sLine Like "* _" Then Exit Do
            lLine2 = lLine2 + 1
        Loop
        vbcmA.InsertLines lLine2 + 1, "    If ErrorTrapping Then On Error GoTo ErrHandler"
    Next lLine
End Sub

And rather than pushing things to the Immediate window I used subroutines in a module I named "modLogToWorksheet", the full module being here:

Option Explicit

Private wksLog As Worksheet
Private lRow As Long

Public Sub StartNewWorksheetLog()
    Dim bNewSheet As Boolean
    
    bNewSheet = True
    If ActiveSheet.Type = xlWorksheet Then
        Set wksLog = ActiveSheet
        bNewSheet = Not (wksLog.UsedRange.Cells.Count = 1 And wksLog.Range("A1").Formula = "")
    End If
    If bNewSheet Then Set wksLog = ActiveWorkbook.Worksheets.Add
    lRow = 1
End Sub

Public Sub AddToWksLog(ParamArray sMsg() As Variant)
    Dim lCol As Long

    If wksLog Is Nothing Or lRow = 0 Then StartNewWorksheetLog
        
    If Not (IsNull(sMsg)) Then
        For lCol = 0 To UBound(sMsg)
            If sMsg(lCol) <> "" Then wksLog.Cells(lRow, lCol + 1).Value = "'" & sMsg(lCol)
        Next
    End If
    lRow = lRow + 1
End Sub

And finally, here's my Error Dialog generator:

Public Sub ShowErrorMsg(errThis As ErrObject, strSubName As String, strModName As String _
  , Optional vbMBStyle As VbMsgBoxStyle = vbCritical, Optional sTitle As String = APP_TITLE)
  If errThis.Number <> 0 Then
      MsgBox "An Error Has Occurred in the Add-in.  Please inform " & ADMINS & " of this problem." _
          & vbCrLf & vbCrLf _
          & "Error #:              " & errThis.Number & vbCrLf _
          & "Description: " & "     " & errThis.Description & vbCrLf _
          & "Subroutine: " & "      " & strSubName & vbCrLf _
          & "Module: " & "           " & strModName & vbCrLf _
          & "Source: " & "            " & errThis.Source & vbCrLf & vbCrLf _
          & "Click OK to continue.", vbMBStyle Or vbSystemModal, sTitle
  End If
End Sub

Hope future users find it useful!

Nunn answered 8/11, 2022 at 22:40 Comment(0)

© 2022 - 2024 — McMap. All rights reserved.