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.
No comments:
Post a Comment
Comments subject to moderation before publishing.