正确处理VBA中的错误（Excel）

我一直在使用VBA已经有一段时间了，但我仍然不太确定error handling。

好文章是CPearson.com之一

不过，我仍然想知道如果我以前做ErrorHandling的方式是完全错误的： Block 1

On Error Goto ErrCatcher If UBound(.sortedDates) > 0 Then // Code Else ErrCatcher: // Code End If 

If子句，因为如果它是真的，它将被执行，如果失败，Goto将进入Else部分，因为一个数组的Ubound不应该是0或更less，没有错误，这个方法工作得很好至今。

如果我理解正确的话，应该是这样的： Block 2

 On Error Goto ErrCatcher If Ubound(.sortedDates) > 0 Then // Code End If Goto hereX ErrCatcher: //Code Resume / Resume Next / Resume hereX hereX: 

甚至像这样： Block 3

 On Error Goto ErrCatcher If Ubound(.sortedDates) > 0 Then // Code End If ErrCatcher: If Err.Number <> 0 then //Code End If 

我看到的最常见的方法是，一个，错误“守望者”是在一个子末端和Sub实际上结束之前与一个“退出子”，但是，如果Sub是相当有点混淆大，如果你反过来跳转阅读代码？

4区

以下代码的来源： CPearson.com

  On Error Goto ErrHandler: N = 1 / 0 ' cause an error ' ' more code ' Exit Sub ErrHandler: ' error handling code' Resume Next End Sub 

是否应该像3区？

感谢您阅读我的问题问候skofgar

Answer 1

我绝对不会使用Block1。 在IF语句中错误块与错误无关似乎不正确。

2,3和4块我猜是主题的变化。 我更喜欢仅仅因为对GOTO语句的厌恶而使用3号和4号块; 我通常使用Block4方法。 这是我用来检查是否添加了Microsoft ActiveX Data Objects 2.8库的代码的一个示例，如果不添加或使用较早的版本（如果2.8不可用）。

 Option Explicit Public booRefAdded As Boolean 'one time check for references Public Sub Add_References() Dim lngDLLmsadoFIND As Long If Not booRefAdded Then lngDLLmsadoFIND = 28 ' load msado28.tlb, if cannot find step down versions until found On Error GoTo RefErr: 'Add Microsoft ActiveX Data Objects 2.8 Application.VBE.ActiveVBProject.references.AddFromFile _ Environ("CommonProgramFiles") + "\System\ado\msado" & lngDLLmsadoFIND & ".tlb" On Error GoTo 0 Exit Sub RefErr: Select Case Err.Number Case 0 'no error Case 1004 'Enable Trust Centre Settings MsgBox ("Certain VBA References are not available, to allow access follow these steps" & Chr(10) & _ "Goto Excel Options/Trust Centre/Trust Centre Security/Macro Settings" & Chr(10) & _ "1. Tick - 'Disable all macros with notification'" & Chr(10) & _ "2. Tick - 'Trust access to the VBA project objects model'") End Case 32813 'Err.Number 32813 means reference already added Case 48 'Reference doesn't exist If lngDLLmsadoFIND = 0 Then MsgBox ("Cannot Find Required Reference") End Else For lngDLLmsadoFIND = lngDLLmsadoFIND - 1 To 0 Step -1 Resume Next lngDLLmsadoFIND End If Case Else MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!" End End Select On Error GoTo 0 End If booRefAdded = TRUE End Sub 

Answer 2

ray023有一个真正奇妙的答案，但是你的评论可能是矫枉过正的。 对于“更轻”的版本….

第一块，恕我直言，不好的做法。 正如osknows已经指出的那样，混合error handling与正常path代码是不好的。 一方面，如果在出现错误条件时抛出一个新错误，您将无法获得处理该错误的机会（除非您从一个也具有一个error handling程序的例程调用，执行程序将“冒泡” ）。

块2看起来像一个Try / Catch块的模仿。 应该没问题，但不是VBA方式。 方块3是方块2的变体。

Block 4是The VBA Way的简单版本。 我强烈build议使用它，或者类似的东西，因为这是任何其他VBA编程人员所期望的。 但是，让我进行一个小的扩展：

 Private Sub DoSomething() On Error GoTo ErrHandler 'Dim as required 'functional code that might throw errors ExitSub: 'any always-execute (cleanup?) code goes here -- analagous to a Finally block. 'don't forget to do this -- you don't want to fall into error handling when there's no error Exit Sub ErrHandler: 'can Select Case on Err.Number if there are any you want to handle specially 'display to user MsgBox "Something's wrong: " & vbCrLf & Err.Description 'or use a central DisplayErr routine, written Public in a Module DisplayErr Err.Number, Err.Description Resume ExitSub Resume End Sub 

请注意，第二个Resume 。 这是我最近学到的一个技巧：它将永远不会在正常处理中执行，因为Resume <label>语句将在其他地方执行。 尽pipe如此，它可能是天赐良机。 当您收到错误通知时，请selectdebugging（或者按Ctl-Break，然后在得到“执行被中断”消息时selectdebugging）。 下一个（突出显示的）语句将是MsgBox或以下语句。 使用“设置下一条语句”（Ctl-F9）突出显示Resume ，然后按F8键。 这将告诉你到底在哪里发生了错误。

至于你反对这种格式的“跳来跳去”，A）正如前面所说的那样，VBA程序员期望的就是B）你的例程应该足够短，以至于跳不了多远。

Answer 3

error handling的两个主要目的：

1. 陷阱错误，你可以预测，但不能控制用户做（例如，当拇指驱动器已被删除时保存文件到拇指驱动器）
2. 对于意外的错误，向用户提供一个表单，通知他们问题是什么。 这样，他们就可以把这个信息传达给你，而你在修复问题时可能会给他们一个解决办法。

那么，你将如何做到这一点？

首先，创build一个错误表单，以在发生意外错误时显示。

它可能看起来像这样（FYI：我被称为frmErrors）：

注意以下标签：

• lblHeadline
• lblSource
• lblProblem
• lblResponse

另外，标准的命令button：

• 忽视
• 重试
• 取消

这个表单的代码没有什么特别的：

 Option Explicit Private Sub cmdCancel_Click() Me.Tag = CMD_CANCEL Me.Hide End Sub Private Sub cmdIgnore_Click() Me.Tag = CMD_IGNORE Me.Hide End Sub Private Sub cmdRetry_Click() Me.Tag = CMD_RETRY Me.Hide End Sub Private Sub UserForm_Initialize() Me.lblErrorTitle.Caption = "Custom Error Title Caption String" End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 'Prevent user from closing with the Close box in the title bar. If CloseMode <> 1 Then cmdCancel_Click End If End Sub 

基本上，你想知道当表单closures时用户按下了哪个button。

接下来，创build一个将在整个VBA应用程序中使用的error handling程序模块：

 '**************************************************************** ' MODULE: ErrorHandler ' ' PURPOSE: A VBA Error Handling routine to handle ' any unexpected errors ' ' Date: Name: Description: ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '03/22/2010 Ray Initial Creation '**************************************************************** Option Explicit Global Const CMD_RETRY = 0 Global Const CMD_IGNORE = 1 Global Const CMD_CANCEL = 2 Global Const CMD_CONTINUE = 3 Type ErrorType iErrNum As Long sHeadline As String sProblemMsg As String sResponseMsg As String sErrorSource As String sErrorDescription As String iBtnCap(3) As Integer iBitmap As Integer End Type Global gEStruc As ErrorType Sub EmptyErrStruc_S(utEStruc As ErrorType) Dim i As Integer utEStruc.iErrNum = 0 utEStruc.sHeadline = "" utEStruc.sProblemMsg = "" utEStruc.sResponseMsg = "" utEStruc.sErrorSource = "" For i = 0 To 2 utEStruc.iBtnCap(i) = -1 Next utEStruc.iBitmap = 1 End Sub Function FillErrorStruct_F(EStruc As ErrorType) As Boolean 'Must save error text before starting new error handler 'in case we need it later EStruc.sProblemMsg = Error(EStruc.iErrNum) On Error GoTo vbDefaultFill EStruc.sHeadline = "Error " & Format$(EStruc.iErrNum) EStruc.sProblemMsg = EStruc.sErrorDescription EStruc.sErrorSource = EStruc.sErrorSource EStruc.sResponseMsg = "Contact the Company and tell them you received Error # " & Str$(EStruc.iErrNum) & ". You should write down the program function you were using, the record you were working with, and what you were doing." Select Case EStruc.iErrNum 'Case Error number here 'not sure what numeric errors user will ecounter, but can be implemented here 'eg 'EStruc.sHeadline = "Error 3265" 'EStruc.sResponseMsg = "Contact tech support. Tell them what you were doing in the program." Case Else EStruc.sHeadline = "Error " & Format$(EStruc.iErrNum) & ": " & EStruc.sErrorDescription EStruc.sProblemMsg = EStruc.sErrorDescription End Select GoTo FillStrucEnd vbDefaultFill: 'Error Not on file EStruc.sHeadline = "Error " & Format$(EStruc.iErrNum) & ": Contact Tech Support" EStruc.sResponseMsg = "Contact the Company and tell them you received Error # " & Str$(EStruc.iErrNum) FillStrucEnd: Exit Function End Function Function iErrorHandler_F(utEStruc As ErrorType) As Integer Static sCaption(3) As String Dim i As Integer Dim iMCursor As Integer Beep 'Setup static array If Len(sCaption(0)) < 1 Then sCaption(CMD_IGNORE) = "&Ignore" sCaption(CMD_RETRY) = "&Retry" sCaption(CMD_CANCEL) = "&Cancel" sCaption(CMD_CONTINUE) = "Continue" End If Load frmErrors 'Did caller pass error info? If not fill struc with the needed info If Len(utEStruc.sHeadline) < 1 Then i = FillErrorStruct_F(utEStruc) End If frmErrors!lblHeadline.Caption = utEStruc.sHeadline frmErrors!lblProblem.Caption = utEStruc.sProblemMsg frmErrors!lblSource.Caption = utEStruc.sErrorSource frmErrors!lblResponse.Caption = utEStruc.sResponseMsg frmErrors.Show iErrorHandler_F = frmErrors.Tag ' Save user response Unload frmErrors ' Unload and release form EmptyErrStruc_S utEStruc ' Release memory End Function 

您可能有错误，这些错误只会自定义到您的应用程序中。 这通常只是一个特定于您的应用程序的错误列表。 如果您还没有常量模块，请创build一个包含自定义错误的ENUM的模块。 （注意：Office '97不支持ENUMS）。 ENUM应该是这样的：

 Public Enum CustomErrorName MaskedFilterNotSupported InvalidMonthNumber End Enum 

创build一个将会抛出自定义错误的模块。

 '******************************************************************************************************************************** ' MODULE: CustomErrorList ' ' PURPOSE: For trapping custom errors applicable to this application ' 'INSTRUCTIONS: To use this module to create your own custom error: ' 1. Add the Name of the Error to the CustomErrorName Enum ' 2. Add a Case Statement to the raiseCustomError Sub ' 3. Call the raiseCustomError Sub in the routine you may see the custom error ' 4. Make sure the routine you call the raiseCustomError has error handling in it ' ' ' Date: Name: Description: ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '03/26/2010 Ray Initial Creation '******************************************************************************************************************************** Option Explicit Const MICROSOFT_OFFSET = 512 'Microsoft reserves error values between vbObjectError and vbObjectError + 512 '************************************************************************************************ ' FUNCTION: raiseCustomError ' ' PURPOSE: Raises a custom error based on the information passed ' 'PARAMETERS: customError - An integer of type CustomErrorName Enum that defines the custom error ' errorSource - The place the error came from ' ' Returns: The ASCII vaule that should be used for the Keypress ' ' Date: Name: Description: ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '03/26/2010 Ray Initial Creation '************************************************************************************************ Public Sub raiseCustomError(customError As Integer, Optional errorSource As String = "") Dim errorLong As Long Dim errorDescription As String errorLong = vbObjectError + MICROSOFT_OFFSET + customError Select Case customError Case CustomErrorName.MaskedFilterNotSupported errorDescription = "The mask filter passed is not supported" Case CustomErrorName.InvalidMonthNumber errorDescription = "Invalid Month Number Passed" Case Else errorDescription = "The custom error raised is unknown." End Select Err.Raise errorLong, errorSource, errorDescription End Sub 

您现在已经能够在程序中捕获错误。 你子（或function），应该看起来像这样：

 Public Sub MySub(monthNumber as Integer) On Error GoTo eh Dim sheetWorkSheet As Worksheet 'Run Some code here '************************************************ '* OPTIONAL BLOCK 1: Look for a specific error '************************************************ 'Temporarily Turn off Error Handling so that you can check for specific error On Error Resume Next 'Do some code where you might expect an error. Example below: Const ERR_SHEET_NOT_FOUND = 9 'This error number is actually subscript out of range, but for this example means the worksheet was not found Set sheetWorkSheet = Sheets("January") 'Now see if the expected error exists If Err.Number = ERR_SHEET_NOT_FOUND Then MsgBox "Hey! The January worksheet is missing. You need to recreate it." Exit Sub ElseIf Err.Number <> 0 Then 'Uh oh...there was an error we did not expect so just run basic error handling GoTo eh End If 'Finished with predictable errors, turn basic error handling back on: On Error GoTo eh '********************************************************************************** '* End of OPTIONAL BLOCK 1 '********************************************************************************** '********************************************************************************** '* OPTIONAL BLOCK 2: Raise (aka "Throw") a Custom Error if applicable '********************************************************************************** If not (monthNumber >=1 and monthnumber <=12) then raiseCustomError CustomErrorName.InvalidMonthNumber, "My Sub" end if '********************************************************************************** '* End of OPTIONAL BLOCK 2 '********************************************************************************** 'Rest of code in your sub goto sub_exit eh: gEStruc.iErrNum = Err.Number gEStruc.sErrorDescription = Err.Description gEStruc.sErrorSource = Err.Source m_rc = iErrorHandler_F(gEStruc) If m_rc = CMD_RETRY Then Resume End If sub_exit: 'Any final processing you want to do. 'Be careful with what you put here because if it errors out, the error rolls up. This can be difficult to debug; especially if calling routine has no error handling. Exit Sub 'I was told a long time ago (10+ years) that exit sub was better than end sub...I can't tell you why, so you may not want to put in this line of code. It's habit I can't break :P End Sub 

上面的代码的复制/粘贴可能无法正常工作，但一定要给你的要点。

顺便说一句，如果你需要我做你的公司标志，请看我在http://www.MySuperCrappyLogoLabels99.com

Answer 4

我保持简单：
在模块级别，我定义了两个variables，并将其中一个设置为模块本身的名称。

  Private Const ThisModuleName As String = "mod_Custom_Functions" Public sLocalErrorMsg As String 

在模块的每个子/function中，我定义一个局部variables

  Dim ThisRoutineName As String 

我将ThisRoutineName设置为子或函数的名称

 ' Housekeeping On Error Goto ERR_RTN ThisRoutineName = "CopyWorksheet" 

然后我把所有错误发送到ERR_RTN：当它们发生时，我首先设置sLocalErrorMsg来定义错误实际是什么，并提供一些debugging信息。

  If Len(Trim(FromWorksheetName)) < 1 Then sLocalErrorMsg = "Parameter 'FromWorksheetName' Is Missing." GoTo ERR_RTN End If 

在每个子/函数的底部，我按如下指示逻辑stream程

  ' ' The "normal" logic goes here for what the routine does ' GoTo EXIT_RTN ERR_RTN: On Error Resume Next ' Call error handler if we went this far. ErrorHandler ThisModuleName, ThisRoutineName, sLocalErrorMsg, Err.Description, Err.Number, False EXIT_RTN: On Error Resume Next ' ' Some closing logic ' End If 

然后我有一个单独的模块，我把所有的项目称为“mod_Error_Handler”。

  ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Subroutine Name: ErrorHandler ' ' ' ' Description: ' ' This module will handle the common error alerts. ' ' ' ' Inputs: ' ' ModuleName String 'The name of the module error is in. ' ' RoutineName String 'The name of the routine error in in. ' ' LocalErrorMsg String 'A local message to assist with troubleshooting.' ' ERRDescription String 'The Windows Error Description. ' ' ERRCode Long 'The Windows Error Code. ' ' Terminate Boolean 'End program if error encountered? ' ' ' ' Revision History: ' ' Date (YYYYMMDD) Author Change ' ' =============== ===================== =============================================== ' ' 20140529 XXXXX X. XXXXX Original ' ' ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Public Sub ErrorHandler(ModuleName As String, RoutineName As String, LocalErrorMsg As String, ERRDescription As String, ERRCode As Long, Terminate As Boolean) Dim sBuildErrorMsg As String ' Build Error Message To Display sBuildErrorMsg = "Error Information:" & vbCrLf & vbCrLf If Len(Trim(ModuleName)) < 1 Then ModuleName = "Unknown" End If If Len(Trim(RoutineName)) < 1 Then RoutineName = "Unknown" End If sBuildErrorMsg = sBuildErrorMsg & "Module Name: " & ModuleName & vbCrLf & vbCrLf sBuildErrorMsg = sBuildErrorMsg & "Routine Name: " & RoutineName & vbCrLf & vbCrLf If Len(Trim(LocalErrorMsg)) > 0 Then sBuildErrorMsg = sBuildErrorMsg & "Local Error Msg: " & LocalErrorMsg & vbCrLf & vbCrLf End If If Len(Trim(ERRDescription)) > 0 Then sBuildErrorMsg = sBuildErrorMsg & "Program Error Msg: " & ERRDescription & vbCrLf & vbCrLf If IsNumeric(ERRCode) Then sBuildErrorMsg = sBuildErrorMsg & "Program Error Code: " & Trim(Str(ERRCode)) & vbCrLf & vbCrLf End If End If MsgBox sBuildErrorMsg, vbOKOnly + vbExclamation, "Error Detected!" If Terminate Then End End If End Sub 

最终的结果是一个popup的错误消息，告诉我什么模块，什么样的程序，以及错误消息具体是什么。 另外，它也会插入Windows的错误信息和代码。

Answer 5

块2不起作用，因为它不会重置error handling程序，从而导致无限循环。 要使error handling在VBA中正常工作，需要使用Resume语句来清除error handling程序。 Resume也重新激活以前的error handling程序。 块2失败，因为新的错误将返回到前一个error handling程序导致无限循环。

块3失败，因为没有Resume语句，所以任何尝试error handling将失败。

每个error handling程序必须通过退出过程或Resume语句来结束。 围绕error handling程序路由正常执行是令人困惑的。 这就是error handling程序通常位于底部的原因。

但是，这是处理VBA中的错误的另一种方法。 它处理像VB.net中的Try / Catch这样的内联错误。有几个缺陷，但是正确的pipe理，它工作得非常好。

 Sub InLineErrorHandling() 'code without error handling BeginTry1: 'activate inline error handler On Error GoTo ErrHandler1 'code block that may result in an error Dim a As String: a = "Abc" Dim c As Integer: c = a 'type mismatch ErrHandler1: 'handle the error If Err.Number <> 0 Then 'the error handler has deactivated the previous error handler MsgBox (Err.Description) 'Resume (or exit procedure) is the only way to get out of an error handling block 'otherwise the following On Error statements will have no effect 'CAUTION: it also reactivates the previous error handler Resume EndTry1 End If EndTry1: 'CAUTION: since the Resume statement reactivates the previous error handler 'you must ALWAYS use an On Error GoTo statement here 'because another error here would cause an endless loop 'use On Error GoTo 0 or On Error GoTo <Label> On Error GoTo 0 'more code with or without error handling End Sub 

资料来源：

• http://www.cpearson.com/excel/errorhandling.htm
• http://msdn.microsoft.com/en-us/library/bb258159.aspx

使这项工作的关键是使用Resume语句紧接着另一个On Error语句。 Resume在error handling程序中并将代码转移到EndTry1标签。 您必须立即设置另一个On Error语句以避免问题，因为之前的error handling程序将“继续”。 也就是说，它会积极准备处理另一个错误。 这可能会导致错误重复，并进入一个无限循环。

要避免再次使用以前的error handling程序，您需要将On Error设置为新的error handling程序，或者使用On Error Goto 0取消所有error handling。