VBA错误处理程序，发生错误时给我发电子邮件

Question

我为一个更大的程序创建了一个错误处理程序，当发生错误时，它会给我发电子邮件，其中包括错误发生在哪一行以及它发生的整个函数/子的代码。

问题是此代码完全依赖于代码中每一行的行号。我想重新创建此功能，而不必在进行更改时修改行号。

有人有什么建议吗？这是我现在使用的：

Public Sub EmailErrror(e As ErrObject, eLine As Integer, eSheet As String)
Dim OutApp As Outlook.Application
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = Outlook.Application
Set OutMail = OutApp.CreateItem(0)

Dim eProc, eCode, eProcCode, eProcStart As Long, eProcLines As Long, eCodeSRow As Long, eCodeSCol As Long, eCodeERow As Long, eCodeECol As Long
ThisWorkbook.VBProject.VBComponents(eSheet).CodeModule.Find eLine & " ", eCodeSRow, eCodeSCol, eCodeERow, eCodeECol
eCode = ThisWorkbook.VBProject.VBComponents(eSheet).CodeModule.Lines(eCodeSRow, Abs(eCodeERow - eCodeSRow) + 1) 'mdl.Lines(lngSLine, Abs(lngELine - lngSLine) + 1)
eProc = ThisWorkbook.VBProject.VBComponents(eSheet).CodeModule.ProcOfLine(eCodeSRow, 0)
eProcStart = ThisWorkbook.VBProject.VBComponents(eSheet).CodeModule.ProcStartLine(eProc, 0)
eProcLines = ThisWorkbook.VBProject.VBComponents(eSheet).CodeModule.ProcCountLines(eProc, 0)
eProcCode = ThisWorkbook.VBProject.VBComponents(eSheet).CodeModule.Lines(eProcStart, eProcLines)

With OutMail
.To = "ME"
.CC = "My boss"
.BCC = ""
.Subject = "Error in " & ThisWorkbook.Name & "!" & eSheet & " on " & eProc
.HTMLBody = "Error in " & ThisWorkbook.Name & " on " & eProc & " line " & eLine & "<BR><BR>"
.HTMLBody = .HTMLBody & "Line Error Occured:<BR><BR>" & eCode
.HTMLBody = .HTMLBody & "<BR><BR>Error: " & e.Number & " - " & e.Description
.HTMLBody = .HTMLBody & "<BR><BR><HR>Full Procedure Code:<BR><BR>" & Replace(Replace(eProcCode, vbCrLf, "<br>"), " ", "&nbsp;")
.Display
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Answer 1

给定非唯一错误号的电子邮件错误信息

"问题在于，这段代码完全依赖于代码中每一行的行号。 我想重新创建这个函数，而不必在进行更改时修改行号。

由于您不希望在进行更改时对同一代码模块的所有其他过程重新编号，从而同时允许对双精度进行编号，因此您必须更改当前逻辑：

而不是在给定代码模块中搜索 (1( 唯一的错误行号，(2( 获取代码模块中的行号 (3( 引发错误的假定代码行，您必须按如下方式处理：

1. 搜索已识别过程的起始行，
2. 此后搜索错误行号，
3. 通过返回结果数组info的帮助程序函数获取引发代码行的错误。

获取错误引发代码行的先决条件

-此代码在激活错误处理程序的goto行标签后假设以下两个条件，例如通过On Error goto OOPS

-i.( 定义模块：将实际模块名称分配给每个代码模块的声明头中MYMODULE的相同常量名称：

Private Const MYMODULE$ = "Module1"     ' << change to actual module name

-二.(定义过程：每个带有错误处理程序的过程通过Err.Source 赋值定义自己的过程名称：

OOPS: Err.Source = "MyProcedure"             ' << change OOPS:  to your default error line label

然后，您始终可以在以下行中使用以下EmailError的 INVARIABLE 调用代码：

EmailError Err, Erl, MYMODULE                   ' invariable call

因此，模块可以按如下方式启动：

Option Explicit                               ' declaration head of code module
Private Const MYMODULE$ = "Module1"           ' (i.) change to actual module name
Sub nonsens2()
10 Dim x                                      ' 30 mustn't be found here
20 On Error GoTo OOPS                         ' On Error Statement defining error line label
30 x = 20 / 0                                 ' error raising code line
done: Exit Sub
OOPS: Err.Source = "nonsens2"                 ' (ii.) Err.Source assignment of current procedure
EmailError Err, Erl, MYMODULE           '       call main procedure to get error info
End Sub

主要程序EmailError

调用过程EmailError(尽可能靠近您的 OP(，以便通过电子邮件发送有关发生错误的信息，并且 依赖于枚举的错误行作为标识符。 由于您不希望对每个代码模块中的所有行重新编号，因此仅在同一过程中使用(唯一(行号。 因此，将重复发现相同的错误行号，并且您必须将搜索字段缩小到给定模块中的给定过程。

除了行号有一个一般的整数限制- 以 (2 ^ 15( -1 = 32767 结尾(由于其在 Basic 中的编程时间较长(，您应该考虑其他重要特性。 这种方法并不假装涵盖了所有可能的变体，但您可以在通过模式搜索查找 VBE 模块中的所有编号行中研究许多有趣的示例。 在获取错误行时，您还应该提供由下划线字符"_"指示的行延续; 此演示仅提供单行换行符，(可以很容易地适应更多：-(

(不要忘记对Microsoft Visual Basic for Applications Extensibility 5.3的引用(

Sub EmailError(e As ErrObject, ByVal eLine As Integer, eSheet$)
' Purpose: email ocurring error based on enumerated error lines (unique only WITHIN same procedure)
Dim OutApp As Outlook.Application
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = Outlook.Application
Set OutMail = OutApp.CreateItem(0)
Dim vERR: vERR = Split(e.Source, " ")
Dim eProcName$: eProcName = IIf(UBound(vERR) = 0, vERR(LBound(vERR)), vERR(UBound(vERR)))
Dim eProcType$: eProcType = IIf(UBound(vERR) = 0, "?", vERR(LBound(vERR)))
If eProcType = "Private" Or eProcType = "Public" Then eProcType = vERR(1)
Dim comp As Object
Set comp = ThisWorkbook.VBProject.VBComponents(eSheet)
'Get results
Dim info
Const EPROC = 0, ECODE = 1, EERL = 2, EPROCSTART = 3, EPROCLINES = 4, ELOCATED = 5
info = getErrLine(comp, eProcName, eLine)    ' << call helper function to get code line information
With OutMail
.To = "ME"
.CC = "My boss"
.BCC = ""
.Subject = "Error in " & ThisWorkbook.Name & IIf(comp.Type = 100, "!" & eSheet & " in procedure " & Split(info(EPROC), ".")(1), " in procedure " & info(EPROC))
.HTMLBody = "Error in " & ThisWorkbook.Name & " in procedure " & info(EPROC) & " at ERL line " & info(EERL) & "<br/>"
.HTMLBody = .HTMLBody & "(Procedure """ & Split(info(EPROC), ".")(1) & """ starts at line " & info(EPROCSTART) & " and counts " & info(EPROCLINES) & " lines)<br/><br/>"
.HTMLBody = .HTMLBody & "Module Line Error Occured:<br/><br/>" & info(ELOCATED)
.HTMLBody = .HTMLBody & "<br/><br/>Error: " & e.Number & " - " & e.Description
.HTMLBody = .HTMLBody & "<br/><br/><hr/>Full Procedure Code:<br/><br/>" & Replace(Replace(info(ECODE), vbCrLf, "<br/>"), " ", "&nbsp;")
.Display
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

帮助程序函数getErrLine()

此帮助程序函数由上述主过程EMailError调用，并在数组中收集引发错误过程的必要代码行信息。旁注：此代码演示了一种可能的方法，但不想赢得选美比赛

Function getErrLine(comp As Object, ByVal eProcName$, ByVal eLine As Integer) As Variant()
' Purpose: return code line information of an error raising procedure in an array
' Note:    called by above error handler procedure EMailError
' Author:  T.M. (https://stackoverflow.com/users/6460297/t-m)
Const EPROC = 0, ECODE = 1, EERL = 2, EPROCSTART = 3, EPROCLINES = 4, ELOCATED = 5, TEST = 6
Dim i&, FoundProc$, eCodeLine$, eCodeSRow&, eCodeSCol&, eCodeERow&, eCodeECol&, bfound As Boolean
Dim a: ReDim a(0 To 6)
If Len(Trim(eProcName)) = 0 Then Exit Function
With comp.CodeModule
a(EPROC) = .Name & "."
' Step 1 - check if correct procedure has been found and get connected data
Do While True
eCodeSRow = eCodeERow + 1
If eCodeERow > .CountOfLines Then
eCodeERow = 0: Exit Function
End If
' locate indicated procedure
.Find eProcName, eCodeSRow, 0, eCodeERow, 0
FoundProc = .ProcOfLine(eCodeSRow, 0)
'        Debug.Print i & ". " & eProcName & "? -> " & eCodeERow, """" & eProc & """"
If eCodeERow = 0 Then
Exit Do
ElseIf FoundProc = eProcName Then      ' found procedure equals indicated procedure
bfound = True:  a(EPROC) = a(EPROC) & FoundProc: Exit Do
End If
Loop
If Not bfound Then
a(EPROC) = "#Wrong procedure name - nothing found!"
' Step 2 - search indicated Error line and collect connected line infos
Else
Do While True
eCodeSRow = eCodeERow + 1
If eCodeERow > .CountOfLines Then
eCodeERow = 0: Exit Function
End If
' locate indicated ERL
.Find eLine & " ", eCodeSRow, 0, eCodeERow, 0
FoundProc = .ProcOfLine(eCodeSRow, 0)
'        Debug.Print i & ". " & eProcName & "? -> " & eCodeERow, """" & eProc & """"
If eCodeERow = 0 Then Exit Do
If FoundProc = eProcName Then
' usually a line number is followed by a space, but
' can also be followed by an instruction separator ":"
If Split(Replace(.Lines(eCodeERow, 1), ":", ""), " ")(0) = eLine Then bfound = True: Exit Do
End If
Loop
If Not bfound Then
a(EERL) = "Indicated ERL " & eLine & " doesn't exist."
Else  ' search indicated error line
eCodeLine = .Lines(eCodeERow, 1)
If Right(eCodeLine, 1) = "_" Then eCodeLine = .Lines(eCodeERow, 2)
a(ECODE) = eCodeLine                             ' code
a(EERL) = eLine                                  ' ERL
a(EPROCSTART) = .ProcStartLine(FoundProc, 0)     ' eProcStart
a(EPROCLINES) = .ProcCountLines(FoundProc, 0)    ' eProcLines
a(ELOCATED) = eCodeERow                          ' module line raising error
' a(TEST) = .Lines(eCodeERow, 1)                 ' eCode - 1 line only
End If
End If
End With
' return all array information including error line in item 1
getErrLine = a
End Function