Solved: Error Handler: Pass the Calling Macro Info

[griffism]

Folks-

I'm in the business of creating and maintaining bandaids, as such I distribute code to people all over my company. I've created some code that catchs errors and emails me the error information. I'd like to know if I can add the Name (and Line??) of the Macro passing the error information so that I can more easiliy identify the problem. I'd also like to know which errors are non-fatal so that I don't have to worry about those. Also, I can't use any add-ins or plug-ins due to the security policys of the company.

[vba]
Private OLApp As Object
Private OLNS As Object

Private Sub Run()

On Error GoTo Err

' <Code here>

Err:
Select Case Err.Number
Case 0
Resume Next
Case Else
Application.WindowState = xlNormal
Call EmailErr(Str$(Err) & ":" & Err.Description, vbInformation) 'would like to add macro name here
MsgBox "Macro Failed! Error information has been emailed to griffism."
GoTo Exits
End Select
Exits:

End Sub

Private Sub EmailErr(errName As String, errInfo As String) 'mName as string
Dim oMailItem As Object
Dim oRecipient As Object

Set OLApp = CreateObject("Outlook.Application")
Set OLNS = OLApp.GetNameSpace("MAPI")
OLNS.Logon , , True

Set oMailItem = OLApp.CreateItem(0)
Set oRecipient = oMailItem.Recipients.Add("edited by Admin")
oRecipient.Type = 1
With oMailItem
.Subject = "Macro Error"
.Body = "griffism- & vbNewLine & The error is: " & errName & " " & errInfo ' & " " & mName
.Send
End With

End Sub
[/vba]

[Bob Phillips]

There is no built-in way to capture a procedure name. The way I do it is to create a global variable and set that at the start of each procedure. Manually intensive, but it works.

You can get the line number if you add line numbers to the code and then use

[vba]

Public Sub Test()
10 On Error GoTo error_handler

'some code

20 Debug.Print 1 / 0

exit_proc:
30 Exit Sub

error_handler:
40 MsgBox "Error on line " & Erl
50 Resume exit_proc


End Sub
[/vba]

[TomSchreiner]

As XLD stated. It's too bad that there is not an easy method to insert a trace in VBA. If you want the actual line number of the error, you will need to assign it to a variable. It will fatten up your code, but it works wonders to get the specific info you need.

I use a great free addin for VB/VBA called MZTools. One of the functions available is "Insert Line Numbers". I insert the line numbers and then run this procedure to insert an adlib trace. It is simply a local variable that holds the line number of each executable statement. It is not at all eloquent but it serves its purpose. The second procedure shows the result of following the two instructions above. If there is an error, my handler logs the error information plus the line number that caused the error to be raised. It would not be difficult for you to include this information in the body of your email.

[VBA]Private Const ProcedureName As String = "CatchSignal"

Sub AddTrace()

Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim ProcKind As VBIDE.vbext_ProcKind
Dim LineNum As Long
Dim ProcName As String
Dim LineNumber As Integer

Set VBProj = ActiveWorkbook.VBProject

For Each VBComp In VBProj.VBComponents
With VBComp.CodeModule
On Error Resume Next
LineNum = .ProcBodyLine(ProcedureName, ProcKind)
If LineNum <> 0 Then
.InsertLines LineNum + 1, ""
Do
LineNum = LineNum + 1
If IsNumeric(Trim(Left(.Lines(LineNum, 1), 4))) Then
LineNumber = Trim(Left(.Lines(LineNum, 1), 4))
.InsertLines LineNum, "TraceErrorItem = " & LineNumber
LineNum = LineNum + 1
End If
Loop Until (.ProcOfLine(LineNum, ProcKind) <> ProcedureName) Or .Lines(LineNum, 1) = "Err_" & ProcedureName & ":"
End If
End With
Next VBComp

End Sub[/VBA]

[VBA]Friend Sub CatchSignal()
Dim TraceErrorItem As Long

TraceErrorItem = 10
10 On Error GoTo Err_CatchSignal

'Is it possible to get a BUY and SELL signal simultaneously?
TraceErrorItem = 20
20 If (Range("G1").Value = True) And (LastOrder <> Buy1) Then
TraceErrorItem = 30
30 Sheet1.LogRange.Offset(, 15).Value = "Buy1"
TraceErrorItem = 40
40 LastOrder = Buy1
TraceErrorItem = 50
50 wb.Names("BuySig1ProductOneBid").RefersToRange.Value = wb.Names("ProductOneBid").RefersToRange.Value
TraceErrorItem = 60
60 wb.Names("BuySig1ProductTwoBid").RefersToRange.Value = wb.Names("ProductTwoBid").RefersToRange.Value
If wb.TradeWindow Then
TraceErrorItem = 70
70 Sheet6.Action = "BUY"
TraceErrorItem = 80
80 Sheet6.ExampleCreateOCAOrder
End If
TraceErrorItem = 90
90 Call LogOrder
TraceErrorItem = 100
100 Exit Sub
TraceErrorItem = 110
110 End If

TraceErrorItem = 120
120 If (Range("G7").Value = True) And (LastOrder <> Buy2) Then
TraceErrorItem = 130
130 Sheet1.LogRange.Offset(, 15).Value = "Buy2"
TraceErrorItem = 140
140 LastOrder = Buy2
TraceErrorItem = 150
150 wb.Names("BuySig2ProductOneBid").RefersToRange.Value = wb.Names("ProductOneBid").RefersToRange.Value
TraceErrorItem = 160
160 wb.Names("BuySig2ProductTwoBid").RefersToRange.Value = wb.Names("ProductTwoBid").RefersToRange.Value
If wb.TradeWindow Then
TraceErrorItem = 170
170 Sheet6.Action = "BUY"
TraceErrorItem = 180
180 Sheet6.ExampleCreateOCAOrder
End If
TraceErrorItem = 190
190 Call LogOrder
TraceErrorItem = 200
200 Exit Sub
TraceErrorItem = 210
210 End If

TraceErrorItem = 220
220 If (Range("G12").Value = True) And (LastOrder <> Sell1) Then
TraceErrorItem = 230
230 Sheet1.LogRange.Offset(, 15).Value = "Sell1"
TraceErrorItem = 240
240 LastOrder = Sell1
TraceErrorItem = 250
250 wb.Names("SellSig1ProductOneBid").RefersToRange.Value = wb.Names("ProductOneBid").RefersToRange.Value
TraceErrorItem = 260
260 wb.Names("SellSig1ProductTwoBid").RefersToRange.Value = wb.Names("ProductTwoBid").RefersToRange.Value
If wb.TradeWindow Then
TraceErrorItem = 270
270 Sheet6.Action = "SELL"
TraceErrorItem = 280
280 Sheet6.ExampleCreateOCAOrder
End If
TraceErrorItem = 290
290 Call LogOrder
TraceErrorItem = 300
300 Exit Sub
TraceErrorItem = 310
310 End If

TraceErrorItem = 320
320 If (Range("G18").Value = True) And (LastOrder <> Sell2) Then
TraceErrorItem = 330
330 Sheet1.LogRange.Offset(, 15).Value = "Sell2"
TraceErrorItem = 340
340 LastOrder = Sell2
TraceErrorItem = 350
350 wb.Names("SellSig2ProductOneBid").RefersToRange.Value = wb.Names("ProductOneBid").RefersToRange.Value
TraceErrorItem = 360
360 wb.Names("SellSig2ProductTwoBid").RefersToRange.Value = wb.Names("ProductTwoBid").RefersToRange.Value
If wb.TradeWindow Then
TraceErrorItem = 370
370 Sheet6.Action = "SELL"
TraceErrorItem = 380
380 Sheet6.ExampleCreateOCAOrder
End If
TraceErrorItem = 390
390 Call LogOrder
TraceErrorItem = 400
400 Exit Sub
TraceErrorItem = 410
410 End If

TraceErrorItem = 420
420 Exit Sub
Err_CatchSignal:
430 wb.LogError "Err_CatchSignal," & Err.Number & "," & Err.Description & ",Trace: " & CStr(TraceErrorItem)
440 Resume Next
End Sub[/VBA]

[Bob Phillips]

What is wrong with Erl?

[TomSchreiner]

"What is wrong with Erl?"

Hi XLD. Nothing is wrong with it. I missed that detail in your post. Most likely because I did not even know Erl existed. Glad to learn something new that will make my job easier. I seached for this in help and could not find it. I then googled and noted that it is undocumented since VB3 yet it is still available in VB.net. I wonder why? I have only been programming since VB6. Anyway, I am going to put it to good use. Thanks!

[Bob Phillips]

I must admit to having been confused by that post Tom <g>. You referenced mine, then came up with a very convoluted method to do what VBA provides in a one-liner. It's a good game isn't it, still learning after all these years <ebg>.

[TomSchreiner]

Yes. If you don't love learning and you program - what a drag that must be...

[griffism]

Thanks much! I'll play around with it.