Last week I have introduced a Function to insert Error Handling lines into a VBA Function or Sub-Routine automatically. Readers commented saying that it is a good utility but its usage is somewhat cumbersome.

Before running that function the user has to spot some text to search for and then run the function with that search text as parameter. The utility function searches for the text, with .Find() method of the Module Object, to find the search text and select that line within the target Function/Sub-Routine.  Based on the selected line we can read other details of the function/sub-routine, like total number of lines within that function/sub-routine, function header line number and function ending line number.  These parameters must be available to insert the error handling lines in appropriate locations within the procedure.

If there are several functions or sub-routines to insert error handling lines then this method takes some time to cover all of them, one by one.

Here, we will look at a different version of the same function that scans through the entire Module and inserts error handling lines in all of the Functions/Sub-Routines at one go.

Before that,

Technorati Tags:

Links to the earlier Articles are given below, just in case if you would like to take a look at the simple methods of the Module Object we have tried earlier:

Write VBA Code with VBA

VBA Module Object and Methods

Prepare a list of Procedure Names from a Module

Utility for inserting VBA Error Handler Code

The new function is much simpler to use.  Copy and paste the following Code into a new Standard Module and save it:

Public Function ErrorTrap(ByVal str_ModuleName As String)
On Error GoTo ErrorTrap_Error
'Program : Inserting Error Handler Lines automatically
'        : in a VBA Module 
'Author  : a.p.r. pillai
'Date    : December, 2011
'Remarks : All Rights Reserved by
'Parameter List:
'1. strModuleName - Standard Module or Form/Report Module Name

Dim objMdl As Module, x As Boolean, h As Long, i As Integer
Dim w As Boolean, lngR As Long, intJ As Integer, intK As Integer
Dim linesCount As Long, DeclLines As Long, lngK As Long
Dim str_ProcNames(), strProcName As String, strMsg As String
Dim start_line As Long, end_line As Long, strline As String
Dim lng_StartLine As Long, lng_StartCol As Long
Dim lng_EndLine As Long, lng_EndCol As Long, procEnd As String
Dim ErrHandler As String, lngProcLineCount As Long
Dim ErrTrapStartLine As String, lngProcBodyLine As Long

Set objMdl = Modules(str_ModuleName)

linesCount = objMdl.CountOfLines
DeclLines = objMdl.CountOfDeclarationLines
lngR = 1
strProcName = objMdl.ProcOfLine(DeclLines + 1, lngR)
If strProcName = "" Then
   strMsg = str_ModuleName & " Module is Empty." & vbCr & vbCr & "Program Aborted!"
   MsgBox strMsg, , "ErrorTrap()"
   Exit Function
End If
strMsg = strProcName
intJ = 0

'Determine procedure Name for each line after declaraction lines
For lngK = DeclLines + 1 To linesCount
  'compare procedure name with ProcOfLine property
  If strProcName <> objMdl.ProcOfLine(lngK, lngR) Then
     'increment by one
     intJ = intJ + 1
     'get the procedure name of the current program line
     strProcName = objMdl.ProcOfLine(lngK, lngR)
  End If
Next lngK

ReDim str_ProcNames(intJ)

strProcName = strMsg: intJ = 0
str_ProcNames(intJ) = strProcName
For lngK = DeclLines + 1 To linesCount
  'compare procedure name with ProcOfLine property
  If strProcName <> objMdl.ProcOfLine(lngK, lngR) Then
     'increment array index by one
     intJ = intJ + 1
     'get the procedure name of the current program line
     strProcName = objMdl.ProcOfLine(lngK, lngR)
     str_ProcNames(intJ) = strProcName
  End If
For intK = 0 To intJ
    ErrHandler = ""
    ErrTrapStartLine = ""
    'Take the total count of lines in the module including blank lines
    linesCount = objMdl.CountOfLines

    strProcName = str_ProcNames(intK) 'copy procedure name
    'calculate the body line number of procedure
    lng_StartLine = objMdl.ProcBodyLine(strProcName, vbext_pk_Proc)
    'calculate procedure end line number including blank lines after End Sub
    lng_EndLine = lng_StartLine + objMdl.ProcCountLines(strProcName, vbext_pk_Proc) + 1
    lng_StartCol = 0: lng_EndCol = 150
    start_line = lng_StartLine: end_line = lng_EndLine
    'Check for existing Error Handling lines in the current procedure
    x = objMdl.Find("On Error", lng_StartLine, lng_StartCol, lng_EndLine, lng_EndCol)
    If x Then
         GoTo NxtProc
     'Create Error Trap start line
         ErrTrapStartLine = "On Error goto " & strProcName & "_Error" & vbCr
    End If

    ErrHandler = vbCr & strProcName & "_Exit:" & vbCr
    lngProcBodyLine = objMdl.ProcBodyLine(strProcName, vbext_pk_Proc)
    'Set procedure start line number to Procedure Body Line Number
    lng_StartLine = lngProcBodyLine
    'calculate procedure end line to startline + procedure line count + 1
    lng_EndLine = lng_StartLine + objMdl.ProcCountLines(strProcName, vbext_pk_Proc) + 1
    'Save end line number for later use
    'here lng_endline may include blank lines after End Sub line
    lngProcLineCount = lng_EndLine
    'Instead of For...Next loop we could have used the .Find() method
    'but some how it fails to detect End Sub/End Function text
    For h = lng_StartLine To lng_EndLine
      strline = objMdl.Lines(h, 1)
      i = InStr(1, strline, "End Sub")
      If i > 0 Then
          'Format Exit Sub line
          ErrHandler = ErrHandler & "Exit Sub" & vbCr & vbCr
          lngProcLineCount = h 'take the correct end line of End Sub
          h = lng_EndLine + 1
          GoTo xit
         i = InStr(1, strline, "End Function")
         If i > 0 Then
          'Format Exit Function line
          ErrHandler = ErrHandler & "Exit Function" & vbCr & vbCr
          lngProcLineCount = h 'or take the correct endline of End Function
          h = lng_EndLine + 1
          GoTo xit
        End If
      End If

   'create Error Handler lines
   ErrHandler = ErrHandler & strProcName & "_Error:" & vbCr
   ErrHandler = ErrHandler & "MsgBox Err & " & Chr$(34) & " : " & Chr$(34) & " & "
   ErrHandler = ErrHandler & "Err.Description,," & Chr$(34) & strProcName & "()" & Chr$(34) & vbCr
   ErrHandler = ErrHandler & "Resume " & strProcName & "_exit"
  'Insert the Error catch start line immediately below the procedure header line
   objMdl.InsertLines lngProcBodyLine + 1, ErrTrapStartLine
 'Insert the Error Handler lines at the bottom of the Procedure
 'immediately above the 'End Function' or 'End Sub' line
   objMdl.InsertLines lngProcLineCount + 2, ErrHandler

strMsg = "Process Complete." & vbCr & "List of Procedures:" & vbCr
For intK = 0 To intJ
  strMsg = strMsg & "  *  " & str_ProcNames(intK) & "()" & vbCr
MsgBox strMsg, , "ErrorTrap()"

Exit Function

MsgBox Err & " : " & Err.Description, , "ErrorTrap()"
Resume ErrorTrap_Exit
End Function

You can run this function from the Debug Window or from a Command Button Click Event Procedure.  Sample run Syntax on Standard Module:

ErrorTrap “Module Name”


ErrorTrap "Module3"

Module3 will be scanned for Procedure Names and each procedure is checked for the presence of existing Error Handling lines.  If ‘On Error Goto’ statement is encountered anywhere within a procedure then that procedure is skipped and goes to the next one to check.

To run on Form or Report Module use the following Syntax:

ErrorTrap "Form_FormName"


ErrorTrap "Form_Employees"


ErrorTrap "Report_Orders"

When the ErrorTrap() function completes working with a module it displays the list of procedures found in that Module. Sample run image is given below:

Error Trap run result

If you run the ErrorTrap() Program on a Form/Report that doesn’t have a VBA Module ( or its Has Module Property value is set to No) then a Subscript out of Range message is displayed and the program will be aborted.

It is better if you save this Program in your Library Database and link the Library Database to your Project.  Visit the Link: Command Button Animation for details on how to use a database as a Library Database with your own Custom Functions.

I tried to take the ErrorTrap() Function one step further to scan through the entire database Modules and insert error trap routines in all of them, saving each module immediately after changes.  But, Access2007 keep crashing every time and finally I have discarded the idea.  Besides, the above function gives the User more control to review the module subjected to this function for any kind of side effects.

I have test run this function several times and found ok, but field testing may be required under different environment to detect logical errors.  If you find any such errors please give me a feed back through the comment section of this page.  Review each module immediately after running this function for accuracy and use it at your own risk. 

Technorati Tags: ,