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

Question

我一直在使用VBA很长一段时间，但我仍然不太确定错误处理。

一篇好文章是 CPearson.com

的一个但是我一直在想，如果我用来做ErrorHandling中的样子/是完全错误的： 1座

On Error Goto ErrCatcher 
    If UBound(.sortedDates) > 0 Then 

     // Code 

    Else 
ErrCatcher: 
     // Code 

    End If 

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

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

On Error Goto ErrCatcher 
    If Ubound(.sortedDates) > 0 Then 

     // Code 
    End If 

    Goto hereX 

ErrCatcher: 
     //Code 
    Resume/Resume Next/Resume hereX 

hereX: 

甚至是这样的： 3座

On Error Goto ErrCatcher 
    If Ubound(.sortedDates) > 0 Then 

     // Code 
    End If 

ErrCatcher: 
    If Err.Number <> 0 then 
     //Code 
    End If 

最常见的方式，我看到是那一个，那个错误“捕手”在一个子结尾，并且Sub实际上以一个“Exit 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

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

块2,3 & 4我猜是主题的变体。仅仅因为不喜欢GOTO语句，我更喜欢使用3以上的块;我通常使用Block4方法。这是我用来检查是否添加了Microsoft ActiveX Data Objects 2.8 Library的代码的一个示例，如果不添加或使用早期版本（如果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

两个主要用途用于错误处理：

1. 陷阱错误，你可以 预测，但不能从做控制用户 （例如，保存文件到 拇指驱动器时，拇指驱动器 已被删除）
2. 对于意外错误，目前用户使用表格 告知他们问题 是什么。这样，他们可以将 消息中继给您，并且您可能能够 为您提供解决方法，而您在 正在解决问题。

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

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

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

注意以下标签：

• lblHeadline
• lblSource
• lblProblem
• lblResponse

此外，标准的命令按钮：

• 忽略
• 重试
• 取消

没有什么代码壮观这种形式：

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 

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

接下来，创建一个将在您的VBA应用程序使用的错误处理程序模块：

'**************************************************************** 
' 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 
     'e.g. 
     '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 

你可能有错误，这将是自定义的只有你的应用程序。这通常只是一个特定于您的应用程序的简短错误列表。 如果您还没有常量模块，请创建一个包含自定义错误ENUM的模块。 （注意：Office '97不支持ENUMS。）。 ENUM应该看起来像这样：

Public Enum CustomErrorName 
    MaskedFilterNotSupported 
    InvalidMonthNumber 
End Enum 

创建一个模块，它会抛出您的自定义错误。

'******************************************************************************************************************************** 
' 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 

您现在可以在程序中捕获错误。你子（或功能），应该是这个样子：

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 (a.k.a. "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 3

你得从ray023一个真正了不起的答案，但您的评论，这可能是矫枉过正容易。对于“更轻”的版本....

Block 1是，恕我直言，不好的做法。正如osknows已经指出的那样，混合错误处理与正常路径代码是不好的。首先，如果在出现错误条件时抛出新的错误，您将会得到一个机会来处理它（除非您从一个也具有错误处理程序的例程调用，其中执行将“冒泡”）。

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

座4一种变型是VBA方式的一个最基本的版本。我会强烈建议使用它，或类似的东西，因为这是任何其他VBA程序员inherting代码将期望。让我来介绍一个小扩展，虽然：

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>语句将发送到别处执行。不过，它可能是天赐之物。当您收到错误通知时，请选择调试（或按Ctl-Break，然后在您收到“执行已中断”消息时选择调试）。下一个（突出显示的）语句将是MsgBox或以下语句。使用“Set Next Statement”（Ctl-F9）突出显示Resume，然后按F8。这会向您显示正好是错误发生的位置。

至于你反对这种格式“跳来跳去”，A）这是什么VBA编程期望，如前所述，& B）您的程序应该足够短，它的不远处跳。

Answer 4

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

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

在每个子过程/功能I定义本地变量

Dim ThisRoutineName      As String 

我设置ThisRoutineName到子或功能

' Housekeeping 
    On Error Goto ERR_RTN 
    ThisRoutineName = "CopyWorksheet" 

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

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

在每个子/函数的底部，我直接逻辑流程如下

' 
    ' 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 

最终的结果是一个弹出错误信息特灵我什么模块，什么soubroutine，什么错误消息明确了。另外，它还会插入Windows错误消息和代码。

Answer 5

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

块3失败，因为没有Resume语句，所以任何尝试错误处理将失败。

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

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

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位于错误处理程序中，并将代码转移到EndTry1标签。您必须立即设置另一个On Error语句以避免问题，因为之前的错误处理程序将“重新开始”。也就是说，它将会处于活动状态并准备好处理另一个错误。这可能会导致错误重复并进入无限循环。

为避免再次使用上一个错误处理程序，您需要将On Error设置为新的错误处理程序，或者只需使用On Error Goto 0来取消所有错误处理。