Excel VBA 全局错误处理
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/14940697/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA Global error handling
提问by evoandy
Is there a way to do global error handling?
有没有办法进行全局错误处理？
Can I put some code in the Workbook code that will catch any errors that occur within all modules?
我可以在工作簿代码中放入一些代码来捕获所有模块中发生的任何错误吗？
I could put the same error handler in each module but I'm looking for something more general.
我可以在每个模块中放置相同的错误处理程序，但我正在寻找更通用的东西。
I ask because I have sheet names that are stored as global variables like this Sheets(QuoteName). If there is an error then these global variables are lost. I have a macro that will rename the global variables but I put this within Workbook_BeforeSave.
我问是因为我有像这样存储为全局变量的工作表名称Sheets(QuoteName)。如果出现错误，则这些全局变量将丢失。我有一个宏可以重命名全局变量，但我把它放在Workbook_BeforeSave.
I want it to go to the global error handler and rename the global variable if I get a Subscript out of rangeerror for Sheets(QuoteName)
如果出现下标超出范围错误，我希望它转到全局错误处理程序并重命名全局变量Sheets(QuoteName)
回答by Peter Albert
As Sid already mentioned in the comment, there is no central error handler.
正如 Sid 在评论中已经提到的，没有中央错误处理程序。
Best practice is to have a central error handling routine that gets called from the local error handlers. Take a look at the great MZ-Tools: it has the possibility to define a default error handler at the press of a button (Ctrl-E). You can customize this error handler - and it can also contain module and/or sub name!
最佳实践是拥有一个从本地错误处理程序调用的中央错误处理例程。看看伟大的MZ-Tools：它可以在按下按钮 ( Ctrl- E) 时定义默认错误处理程序。您可以自定义此错误处理程序 - 它也可以包含模块和/或子名称！
Additionally, check out this post at Daily Dose of Excel. It is Dick Kusleika's OO version of the error handler proposed in this book(which I can highly recommend).
此外，请在Daily Dose of Excel 上查看这篇文章。这是本书中提出的错误处理程序的 Dick Kusleika 的 OO 版本（我强烈推荐）。
回答by user3666385
Here's some code I threw together to handle the problem in access
这是我为处理访问问题而拼凑的一些代码
It puts error checking in all subs, but not functions. subs have to have a parent form (ACCESS), or alternatively, you have to put the form name in manually. subs that are continued over more than one line will be mercilessly whacked.
它在所有子程序中进行错误检查，但不是函数。subs 必须有一个父表单 (ACCESS)，或者，您必须手动输入表单名称。连续超过一条线路的潜艇将被无情地打击。
The two subs have to be at the bottom of a module.
两个潜艇必须位于模块的底部。
- globalerroris your error management routine
- CleaVBA_clickchanges your VBA code, adds line #s to everything
- globalerror是您的错误管理例程
- CleaVBA_click更改您的 VBA 代码，向所有内容添加行 #s
globalerror looks at a boolean global errortrackingto see if it logs everything or only errors
globalerror 查看布尔全局错误跟踪以查看它是否记录所有内容或仅记录错误
There is a table ErrorTracking that has to be created otherwise just comment out from 1990 to 2160
必须创建一个表 ErrorTracking 否则只需注释掉从 1990 到 2160
When running, it removes then adds line numbers to everything in the project, so your error message can include a line #
运行时，它会删除然后向项目中的所有内容添加行号，因此您的错误消息可以包含一行 #
Not sure if it works on anything other than stuff I've coded.
不确定它是否适用于我编码的东西以外的任何东西。
Be sure to run and test on a copy of your VBA, because it literally rewrites every line of code in your project, and if I screwed up, and you didn't back up, then your project is broken.
一定要在你的 VBA 副本上运行和测试，因为它实际上重写了你项目中的每一行代码，如果我搞砸了，而你没有备份，那么你的项目就坏了。
Public Sub globalerror(Name As String, number As Integer, Description As String, source As String)
1970 Dim db As DAO.Database
1980 Dim rst As DAO.Recordset
1990 If errortracking Or (Err.number <> 0) Then
2000 Set db = CurrentDb
2010 Set rst = db.OpenRecordset("ErrorTracking")
2020 rst.AddNew
2030 rst.Fields("FormModule") = Name
2040 rst.Fields("ErrorNumber") = number
2050 rst.Fields("Description") = Description
2060 rst.Fields("Source") = source
2070 rst.Fields("timestamp") = Now()
2080 rst.Fields("Line") = Erl
2100 rst.Update
2110 rst.Close
2120 db.Close
2130 End If
2140 If Err.number = 0 Then
2150 Exit Sub
2160 End If
2170 MsgBox "ERROR" & vbCrLf & "Location: " & Name & vbCrLf & "Line: " & Erl & vbCrLf & "Number: " & number & vbCrLf & "Description: " & Description & vbCrLf & source & vbCrLf & Now() & vbCrLf & vbCrLf & "custom message"
2180 End Sub
Private Sub CleanVBA_Click()
Dim linekill As Integer
Dim component As Object
Dim index As Integer
Dim str As String
Dim str2a As String
Dim linenumber As Integer
Dim doline As Boolean
Dim skipline As Boolean
Dim selectflag As Boolean
Dim numstring() As String
skipline = False
selectflag = False
tabcounter = 0
For Each component In Application.VBE.ActiveVBProject.VBComponents
linekill = component.CodeModule.CountOfLines
linenumber = 0
For i = 1 To linekill
str = component.CodeModule.Lines(i, 1)
doline = True
If Right(Trim(str), 1) = "_" Then
doline = False
skipline = True
End If
If Len(Trim(str)) = 0 Then
doline = False
End If
If InStr(Trim(str), "'") = 1 Then
doline = False
End If
If selectflag Then
doline = False
End If
If InStr(str, "Select Case") > 0 Then
selectflag = True
End If
If InStr(str, "End Select") > 0 Then
selectflag = False
End If
If InStr(str, "Global ") > 0 Then
doline = False
End If
If InStr(str, "Sub ") > 0 Then
doline = False
End If
If InStr(str, "Option ") > 0 Then
doline = False
End If
If InStr(str, "Function ") > 0 Then
doline = False
End If
If (InStr(str, "Sub ") > 0) Then
If InStr(component.CodeModule.Lines(i + 1, 1), "On Error GoTo error") <> 0 Then
GoTo skipsub
End If
str2a = component.CodeModule.Name
index = InStr(str, "Sub ") ' sub
str = Right(str, Len(str) - index - 3) ' sub
' index = InStr(str, "Function ") ' function
' str = Right(str, Len(str) - index - 8) 'function
index = InStr(str, "(")
str = Left(str, index - 1)
varReturn = SysCmd(acSysCmdSetStatus, "Editing: " & str2a & " : " & str)
DoEvents
If (str = "CleanVBA_Click") Then
MsgBox "skipping self"
GoTo selfie
End If
If str = "globalerror" Then
MsgBox "skipping globalerror"
GoTo skipsub
End If
component.CodeModule.InsertLines i + 1, "On Error GoTo error"
i = i + 1
linekill = linekill + 1
component.CodeModule.InsertLines i + 1, "error:"
i = i + 1
linekill = linekill + 1
component.CodeModule.InsertLines i + 1, "Call globalerror(Me.Form.Name & """ & "-" & str & """, Err.number, Err.description, Err.source)"
i = i + 1
linekill = linekill + 1
component.CodeModule.InsertLines i + 1, " "
i = i + 1
linekill = linekill + 1
If (str = "MashVBA_Click") Then
MsgBox "skipping self"
MsgBox component.CodeModule.Name & " " & str
GoTo selfie
End If
Else
If skipline Then
If doline Then
skipline = False
End If
doline = False
End If
If doline Then
linenumber = linenumber + 10
numstring = Split(Trim(str), " ")
If Len(numstring(0)) >= 2 Then
If IsNumeric(numstring(0)) Then
str = Replace(str, numstring(0), "")
End If
End If
component.CodeModule.ReplaceLine i, linenumber & " " & str
End If
End If
skipsub:
Next i
selfie:
Next
varReturn = SysCmd(acSysCmdSetStatus, " ")
MsgBox "Finished"
End Sub
