VBA中一些良好的错误处理模式是什么？
特别是在以下情况下，应该怎么做：
... some code ...
... some code where an error might occur ...
... some code ...
... some other code where a different error might occur ...
... some other code ...
... some code that must always be run (like a finally block) ...
我希望处理两种错误，并在可能出现错误的代码后恢复执行。此外，最终代码必须在结尾处始终运行 - 无论之前抛出什么异常。如何实现这个结果？
On Error Goto ErrorHandlerLabel（跳转到错误处理程序）Resume (Next | ErrorHandlerLabel)（恢复执行或跳转到错误处理程序）On Error Goto 0（禁用当前错误处理程序）Err 对象Err 对象的属性通常在错误处理程序中被重置为零或零长度字符串，但也可以使用 Err.Clear 显式地进行重置。
错误处理程序中的错误是终止的。
范围为513-65535的数字可用于用户错误。
对于自定义类错误，您需要将 vbObjectError 添加到错误编号中。
请参阅 Microsoft 文档中有关 Err.Raise 和错误编号列表的说明。
对于派生类中未实现的接口成员，应使用常量 E_NOTIMPL = &H80004001。
Option Explicit
Sub HandleError()
Dim a As Integer
On Error GoTo errMyErrorHandler
a = 7 / 0
On Error GoTo 0
Debug.Print "This line won't be executed."
DoCleanUp:
a = 0
Exit Sub
errMyErrorHandler:
MsgBox Err.Description, _
vbExclamation + vbOKCancel, _
"Error: " & CStr(Err.Number)
Resume DoCleanUp
End Sub
Sub RaiseAndHandleError()
On Error GoTo errMyErrorHandler
' The range 513-65535 is available for user errors.
' For class errors, you add vbObjectError to the error number.
Err.Raise vbObjectError + 513, "Module1::Test()", "My custom error."
On Error GoTo 0
Debug.Print "This line will be executed."
Exit Sub
errMyErrorHandler:
MsgBox Err.Description, _
vbExclamation + vbOKCancel, _
"Error: " & CStr(Err.Number)
Err.Clear
Resume Next
End Sub
Sub FailInErrorHandler()
Dim a As Integer
On Error GoTo errMyErrorHandler
a = 7 / 0
On Error GoTo 0
Debug.Print "This line won't be executed."
DoCleanUp:
a = 0
Exit Sub
errMyErrorHandler:
a = 7 / 0 ' <== Terminating error!
MsgBox Err.Description, _
vbExclamation + vbOKCancel, _
"Error: " & CStr(Err.Number)
Resume DoCleanUp
End Sub
Sub DontDoThis()
' Any error will go unnoticed!
On Error Resume Next
' Some complex code that fails here.
End Sub
Sub DoThisIfYouMust()
On Error Resume Next
' Some code that can fail but you don't care.
On Error GoTo 0
' More code here
End Sub
我还想补充一点：
Err对象是你最接近异常对象的东西。Err.Raise有效地“抛出异常”。只是为了好玩：
On Error Resume Next是魔鬼化身，应该避免使用，因为它会默默地隐藏错误。Call mdl_val.usr_sub_handle_error(Err.Source, Err.Description) - DWiener所以你可以这样做：
Function Errorthingy(pParam)
On Error GoTo HandleErr
' Your code here
ExitHere:
' Your finally code
Exit Function
HandleErr:
Select Case Err.Number
' Different error handling here'
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "ErrorThingy"
End Select
Resume ExitHere
End Function
Resume ExitHere，这使得这两种范式之间产生了很大的差异。 - AntoineL这是我的标准实现。我喜欢标签具有自描述性。
Public Sub DoSomething()
On Error GoTo Catch ' Try
' normal code here
Exit Sub
Catch:
'error code: you can get the specific error by checking Err.Number
End Sub
或者，使用 Finally 块：
Public Sub DoSomething()
On Error GoTo Catch ' Try
' normal code here
GoTo Finally
Catch:
'error code
Finally:
'cleanup code
End Sub
Finally块之后出现错误，它将只会抛出该错误。它不会重新回到Finally块。（试一下，你就会看到。）如果你想在Finally块之后处理一个错误，你需要添加另一个On Error GoTo，但可能需要另一个标签，比如Catch2。但是这里我们开始偏离主题，进入了Clean Code方法论-->一个干净的方法只需要一个错误处理程序（甚至应该有自己专用的错误捕获方法）。 - LimaNightHawkFinally:之后发生的事情取决于你是否在被转到Catch:之后输入它（那么是的，它只是抛出）...还是不是！在后一种情况下，即经过GoTo Finally，On Error GoTo Catch仍然有效，因此控制权被转向Catch:（可能是一件好事），然后重新进入Finally:，这可能不是你最初期望的。 - AntoineLOn Error GoTo Catch2，它将在后一种情况下生效，但不会在您之前经历了Catch:的情况下生效，因为没有On Error GoTo -1或任何Resume; 添加前者使我们远离常规的“try catch finally”，人们可能会考虑在那一点之前停止可疑的类比。 - AntoineL在讨论中也与相对不太知名的Erl函数有关。如果您的代码过程中有数字标签，例如：
Sub AAA()
On Error Goto ErrorHandler
1000:
' code
1100:
' more code
1200:
' even more code that causes an error
1300:
' yet more code
9999: ' end of main part of procedure
ErrorHandler:
If Err.Number <> 0 Then
Debug.Print "Error: " + CStr(Err.Number), Err.Descrption, _
"Last Successful Line: " + CStr(Erl)
End If
End Sub
Erl函数返回最近遇到的数字行标签。在上面的示例中，如果在1200:标签之后但在1300:标签之前发生运行时错误，则Erl函数将返回1200，因为那是最近成功遇到的行标签。我认为在错误处理块的上方立即放置一条行标签是一个好习惯。我通常使用9999来表示主过程已按预期完成。
注意：
行标签必须是正整数——像MadeItHere:这样的标签不被Erl识别。
行标签与VBIDE CodeModule的实际行号完全无关。您可以使用任何正数，以任何顺序。在上面的示例中，只有大约25行代码，但行标签号从1000开始。编辑器行号和与Erl一起使用的行标签号之间没有关系。
行标签号不需要按任何特定顺序，但如果它们不按升序自上而下的顺序排列，则Erl的功效和效益将大大降低，但Erl仍将报告正确的数字。
行标签是特定于它们出现的过程的。如果过程ProcA调用过程ProcB，并且在ProcB中发生错误将控制返回到ProcA，则Erl（在ProcA中）将返回在调用ProcB之前在ProcA中最近遇到的行标签号。从ProcA中，您无法获取可能出现在ProcB中的行标签号。
在循环内部放置行号标签时要小心。例如：
For X = 1 To 100
500:
' some code that causes an error
600:
Next X
500 但在 600 之前，则 Erl 将返回 500，即使在以前的 19 次迭代中已经成功地遇到了 600。Erl 函数获取真正有意义的信息至关重要。Erl 的值提供给该信息可以使查找和修复问题比不报告 Erl 的值简单得多。我使用自己开发的一段代码，对我的程序非常有效：
在函数或子程序的开头，我定义：
On error Goto ErrorCatcher:
接下来，我会处理可能出现的错误。
ErrorCatcher:
Select Case Err.Number
Case 0 ' Exit the code when no error was raised
On Error GoTo 0
Exit Function
Case 1 ' Error on definition of object
'do stuff
Case... ' A little description here
' Do stuff
Case Else
Debug.Print "###ERROR"
Debug.Print " • Number :", Err.Number
Debug.Print " • Descrip :", Err.Description
Debug.Print " • Source :", Err.Source
Debug.Print " • HelpCont:", Err.HelpContext
Debug.Print " • LastDLL :", Err.LastDllError
Stop
Err.Clear
Resume
End Select
function something() as ResultType
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim res as ResultType
' Partial declaration block shown
on error goto errHandler
res.errMsg = ""
do ' Dummy loop
Set conn = initDB(databaseFilename)
conn.BeginTrans
Set rstCust = New ADODB.Recordset
sql = "SELECT cust_name FROM customers"
rstCust.Open sql, conn, adOpenKeyset, adLockOptimistic
....
....
if needToExit then
res.errMsg = "Couldn't stand the weather"
exit do
end if
....
....
if gotToGetOutOfHere then
exit do
end if
....
loop until true
' End of code. Single exit point for all above code
' Think of this as the 'exit' handler that
' handles both error and normal exits
errHandler:
if Err.number <> 0 then
res.errMsg = Err.description
end if
If Not rst Is Nothing Then
If rst.State = adStateOpen Then
rst.Close
End If
Set rst = Nothing
End If
If Not conn Is Nothing Then
If res.errMsg = "" Then
conn.CommitTrans
Else
conn.RollbackTrans
End If
conn.Close
Set conn = Nothing
End If
something = res
end function
我发现以下方法最有效，被称为中央错误处理方法。
您有两种运行应用程序的模式：调试模式和生产模式。在调试模式下，代码将在任何意外错误处停止，并通过按两次F8跳转到它出现的行进行轻松调试。在生产模式下，用户将看到有意义的错误消息。
您可以像这样抛出有意的错误，从而停止向用户显示带有消息的代码执行：
Err.Raise vbObjectError, gsNO_DEBUG, "Some meaningful error message to the user"
Err.Raise vbObjectError, gsUSER_MESSAGE, "Some meaningful non-error message to the user"
'Or to exit in the middle of a call stack without a message:
Err.Raise vbObjectError, gsSILENT
您需要使用以下标头和页脚“包装”所有有大量代码的子例程和函数，并确保在所有入口点中指定ehCallTypeEntryPoint。请注意msModule常量，它需要放在所有模块中。
Option Explicit
Const msModule As String = "<Your Module Name>"
' This is an entry point
Public Sub AnEntryPoint()
Const sSOURCE As String = "AnEntryPoint"
On Error GoTo ErrorHandler
'Your code
ErrorExit:
Exit Sub
ErrorHandler:
If CentralErrorHandler(Err, ThisWorkbook, msModule, sSOURCE, ehCallTypeEntryPoint) Then
Stop
Resume
Else
Resume ErrorExit
End If
End Sub
' This is any other subroutine or function that isn't an entry point
Sub AnyOtherSub()
Const sSOURCE As String = "AnyOtherSub"
On Error GoTo ErrorHandler
'Your code
ErrorExit:
Exit Sub
ErrorHandler:
If CentralErrorHandler(Err, ThisWorkbook, msModule, sSOURCE) Then
Stop
Resume
Else
Resume ErrorExit
End If
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments: Error handler code.
'
' Run SetDebugMode True to use debug mode (Dev mode)
' It will be False by default (Production mode)
'
' Author: Igor Popov
' Date: 13 Feb 2014
' Licence: MIT
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Option Private Module
Private Const msModule As String = "MErrorHandler"
Public Const gsAPP_NAME As String = "<You Application Name>"
Public Const gsSILENT As String = "UserCancel" 'A silent error is when the user aborts an action, no message should be displayed
Public Const gsNO_DEBUG As String = "NoDebug" 'This type of error will display a specific message to the user in situation of an expected (provided-for) error.
Public Const gsUSER_MESSAGE As String = "UserMessage" 'Use this type of error to display an information message to the user
Private Const msDEBUG_MODE_COMPANY = "<Your Company>"
Private Const msDEBUG_MODE_SECTION = "<Your Team>"
Private Const msDEBUG_MODE_VALUE = "DEBUG_MODE"
Public Enum ECallType
ehCallTypeRegular = 0
ehCallTypeEntryPoint
End Enum
Public Function DebugMode() As Boolean
DebugMode = CBool(GetSetting(msDEBUG_MODE_COMPANY, msDEBUG_MODE_SECTION, msDEBUG_MODE_VALUE, 0))
End Function
Public Sub SetDebugMode(Optional bMode As Boolean = True)
SaveSetting msDEBUG_MODE_COMPANY, msDEBUG_MODE_SECTION, msDEBUG_MODE_VALUE, IIf(bMode, 1, 0)
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Comments: The central error handler for all functions
' Displays errors to the user at the entry point level, or, if we're below the entry point, rethrows it upwards until the entry point is reached
'
' Returns True to stop and debug unexpected errors in debug mode.
'
' The function can be enhanced to log errors.
'
' Date Developer TDID Comment
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 13 Feb 2014 Igor Popov Created
Public Function CentralErrorHandler(ErrObj As ErrObject, Wbk As Workbook, ByVal sModule As String, ByVal sSOURCE As String, _
Optional enCallType As ECallType = ehCallTypeRegular, Optional ByVal bRethrowError As Boolean = True) As Boolean
Static ssModule As String, ssSource As String
If Len(ssModule) = 0 And Len(ssSource) = 0 Then
'Remember the module and the source of the first call to CentralErrorHandler
ssModule = sModule
ssSource = sSOURCE
End If
CentralErrorHandler = DebugMode And ErrObj.Source <> gsNO_DEBUG And ErrObj.Source <> gsUSER_MESSAGE And ErrObj.Source <> gsSILENT
If CentralErrorHandler Then
'If it's an unexpected error and we're going to stop in the debug mode, just write the error message to the immediate window for debugging
Debug.Print "#Err: " & Err.Description
ElseIf enCallType = ehCallTypeEntryPoint Then
'If we have reached the entry point and it's not a silent error, display the message to the user in an error box
If ErrObj.Source <> gsSILENT Then
Dim sMsg As String: sMsg = ErrObj.Description
If ErrObj.Source <> gsNO_DEBUG And ErrObj.Source <> gsUSER_MESSAGE Then sMsg = "Unexpected VBA error in workbook '" & Wbk.Name & "', module '" & ssModule & "', call '" & ssSource & "':" & vbCrLf & vbCrLf & sMsg
MsgBox sMsg, vbOKOnly + IIf(ErrObj.Source = gsUSER_MESSAGE, vbInformation, vbCritical), gsAPP_NAME
End If
ElseIf bRethrowError Then
'Rethrow the error to the next level up if bRethrowError is True (by Default).
'Otherwise, do nothing as the calling function must be having special logic for handling errors.
Err.Raise ErrObj.Number, ErrObj.Source, ErrObj.Description
End If
End Function
要将自己设置为调试模式，请在立即窗口中运行以下命令：
SetDebugMode True
这是一个相当不错的模式。
用于调试：当出现错误时，请按下 Ctrl + Break（或 Ctrl + Pause） 键，拖动中断标记（或者称为其他名称）到 恢复 行，按 F8 键，您将跳转到“抛出”错误的行。
ExitHandler 就像您的 "Finally" 一样。
每次都会关闭沙漏并清除状态栏文本。
Public Sub ErrorHandlerExample()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
On Error GoTo ErrHandler
Dim varRetVal As Variant
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SomeTable", dbOpenDynaset, dbSeeChanges + dbFailOnError)
Call DoCmd.Hourglass(True)
' Do something with the RecordSet and close it.
Call DoCmd.Hourglass(False)
ExitHandler:
Set rst = Nothing
Set dbs = Nothing
Exit Sub
ErrHandler:
Call DoCmd.Hourglass(False)
Call DoCmd.SetWarnings(True)
varRetVal = SysCmd(acSysCmdClearStatus)
Dim errX As DAO.Error
If Errors.Count > 1 Then
For Each errX In DAO.Errors
MsgBox "ODBC Error " & errX.Number & vbCrLf & errX.Description
Next errX
Else
MsgBox "VBA Error " & Err.Number & ": " & vbCrLf & Err.Description & vbCrLf & "In: Form_MainForm", vbCritical
End If
Resume ExitHandler
Resume
End Sub
Select Case Err.Number
Case 3326 'This Recordset is not updateable
'Do something about it. Or not...
Case Else
MsgBox "VBA Error " & Err.Number & ": " & vbCrLf & Err.Description & vbCrLf & "In: Form_MainForm", vbCritical
End Select
Select Case Err.Number
Case 3326 'This Recordset is not updateable
'Do something about it. Or not...
Case Else
MsgBox "VBA Error " & Err.Number & ": " & vbCrLf & Err.Description & vbCrLf & "In: Form_MainForm", vbCritical
End Select
Resume ExitHandler : Resume这样的写法。不确定它的作用是什么。 - johny why