VB/VBA Automatic Error Handler Code

Bbcalagu
Posted by Bbcalagu under Others category on | Points: 40 | Views : 1724
Hi

It will be very easier if we have a code to put error handler for our procedures and functions automatically.

Add "Microsoft Visual Basic for Applications Extensibility 5.3" on the project reference
Please copy below code and paste it in a standard module of your project.

Scroll down for more instructions

------------------------------------------------------------------------------------------------------------------------------------
Sub AutoErr()
On Error GoTo ErrorPoint
Dim ActiveModName As VBIDE.CodeModule
Dim CalledLine As Long
Dim StartLine As Long
Dim ProcStartLine As Long
Dim ProcType() As String
Dim ProcName As String

Set ActiveModName = Application.VBE.ActiveCodePane.CodeModule
CalledLine = GetTextLine(ActiveModName, "AutoErr")
ProcName = ActiveModName.ProcOfLine(CalledLine, vbext_pk_Proc)
ProcStartLine = ActiveModName.ProcStartLine(ProcName, vbext_pk_Proc)

Do While ActiveModName.Lines(ProcStartLine, 1) = ""
ProcStartLine = ProcStartLine + 1
Loop

ProcType = Split(Trim(Replace(Replace(ActiveModName.Lines(ProcStartLine, 1), "Public", ""), "Private", "")), " ")
StartLine = ProcStartLine + 1

If StartLine <> 1 Then
With ActiveModName
.DeleteLines GetTextLine(ActiveModName, "AutoErr"), 1
.InsertLines StartLine, "'" & IIf(ProcType(0) = "Sub", "Procedure", "Function") & " for"
.InsertLines StartLine + 1, "'----------------------------------------------"
.InsertLines StartLine + 2, "'Comments :"
.InsertLines StartLine + 3, "'"
.InsertLines StartLine + 4, "'"
.InsertLines StartLine + 5, "'"
.InsertLines StartLine + 6, "'Coded by " & Environ("UserName")
.InsertLines StartLine + 7, "On Error Goto ErrorPoint"
.InsertLines StartLine + 8, ""
.InsertLines StartLine + 9, ""
.InsertLines StartLine + 10, IIf(ProcType(0) = "Sub", "Exit Sub", "Exit Function")
.InsertLines StartLine + 11, "ErrorPoint:"
.InsertLines StartLine + 12, " MsgBox ""Error: "" & Err.Description & " _
& " vbNewLine & ""Error No: "" & Err.Number " & _
" & vbNewLine & ""Line No: "" & Erl, " & _
"vbCritical, ""Error on " & ProcName & " in Module : " & ActiveModName & ""
End With
End If
Exit Sub
ErrorPoint:
MsgBox "Error: " & Err.Description & vbNewLine & "Error No: " & Err.Number & vbNewLine & "Line No: " & Erl, vbCritical, "Error on Sub AutoErr in Module : " & ActiveModName
End Sub


Function GetTextLine(ByVal cPan As VBIDE.CodeModule, ByVal ProcName As String) As Long
On Error GoTo ErrorPoint

Dim NoOfLines As Long
Dim i As Long

NoOfLines = cPan.CountOfLines

For i = 1 To NoOfLines - 1
If cPan.Lines(i, 1) Like ProcName & "*" Then
GetTextLine = i
Exit For
End If
Next

Exit Function
ErrorPoint:
MsgBox "Error: " & Err.Description & vbNewLine & "Error No: " & Err.Number & vbNewLine & "Line No: " & Erl, vbCritical, "Error on Fucntion GetTextLine in Module : " & cPan
End Function

------------------------------------------------------------------------------------------------------------------------------------
How to call this code?

Create your procedure/Function without parameter in any standard module => type "AutoErr" => press F5
(You can add the parameters once you execute AutoErr code by pressing F5)

For eg:

Sub Test()
AutoErr
End Sub

After you pressed F5 on the line of AutoErr you can see the procedure/function turns as below

Sub test()
'Procedure for
'----------------------------------------------
'Comments :
'
'
'
'Coded by <UserName>
On Error GoTo ErrorPoint
'your code goes here

Exit Sub
ErrorPoint:
MsgBox "Error: " & Err.Description & vbNewLine & "Error No: " & Err.Number & vbNewLine & "Line No: " & Erl, vbCritical, "Error on test in Module : ThisWorkbook"
End Sub

Note:

If you want to use in Form modules do the following.
1. Once you pressed F5 you will get a dialog box with macro list.
2. Select AutoErr from that list and click run.

Please let me know if some one have more easy way to do this; it will be more appreciated.

Comments or Responses

Login to post response