Introduction.
Last week I 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 a parameter. The utility function searches for the text,.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/subroutine, like the total number of lines within that function/subroutine, 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 in one go.
Before that, Links to the earlier Articles are given below, just in case you would like to take a look at the simple methods of the Module Object we tried earlier:
- Write VBA Code with VBA
- VBA Module Object and Methods
- Prepare a list of Procedure Names from a Module
The ErrorTrap() Function.
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 www.msaccesstips.com '-------------------------------------------------------------- '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 Next 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 Else '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 Else 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 xit: Next '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 NxtProc: Next strMsg = "Process Complete." & vbCr & "List of Procedures:" & vbCr For intK = 0 To intJ strMsg = strMsg & " * " & str_ProcNames(intK) & "()" & vbCr Next MsgBox strMsg, , "ErrorTrap()" ErrorTrap_Exit: Exit Function ErrorTrap_Error: MsgBox Err & " : " & Err.Description, , "ErrorTrap()" Resume ErrorTrap_Exit End Function
Running the Function.
You can run this function from the Debug Window or from a Command Button Click Event Procedure. Sample run on Standard Module:
ErrorTrap “Module Name”
Example-1:
ErrorTrap "Module3"
Module3 will be scanned for Procedure Names and each procedure is checked for the presence of existing Error Handling lines. If the ‘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"
Example-2:
ErrorTrap "Form_Employees"
Example-3
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:
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.
Saving the code in Library Database
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 keeps crashing every time, and finally, I 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 did the test runs on this function several times and found it ok, but field testing may be required in different environments to detect logical errors. If you find any such errors, please give me feedback through the comment section of this page. Review each module immediately after running this function for accuracy and use it at your own risk.