循环中的vba错误处理

vba新手，尝试“错误转到”，但我不断得到错误“索引超出范围”

我只想创建一个组合框，由包含查询表的工作表的名称填充

    For Each oSheet In ActiveWorkbook.Sheets
        On Error GoTo NextSheet:
         Set qry = oSheet.ListObjects(1).QueryTable
         oCmbBox.AddItem oSheet.Name

NextSheet:
    Next oSheet

我不确定问题是否与将On Error GoTo嵌套在循环中有关，或者如何避免使用循环有关。

如何：

    For Each oSheet In ActiveWorkbook.Sheets
        If oSheet.ListObjects.Count > 0 Then
          oCmbBox.AddItem oSheet.Name
        End If
    Next oSheet

---

作为处理循环（如示例代码）中错误的一般方法，我宁愿使用：

on error resume next
for each...
    'do something that might raise an error, then
    if err.number <> 0 then
         ...
    end if
 next ....

出错时继续下一步
对于每个。。。
“那么，做一些可能会引起错误的事情
如果错误号为0，则
...
如果结束
下一个

那怎么办

If oSheet.QueryTables.Count > 0 Then
  oCmbBox.AddItem oSheet.Name
End If 

或

---

问题可能是您尚未从第一个错误恢复。不能从错误处理程序中抛出错误。您应该在resume语句中添加如下内容，以便VBA不再认为您在错误处理程序中：

For Each oSheet In ActiveWorkbook.Sheets
    On Error GoTo NextSheet:
     Set qry = oSheet.ListObjects(1).QueryTable
     oCmbBox.AddItem oSheet.Name
NextSheet:
    Resume NextSheet2
NextSheet2:
Next oSheet

---

实际上，Gabin Smith的答案需要稍加修改才能起作用，因为你不能在没有错误的情况下继续

Sub MyFunc()
...
    For Each oSheet In ActiveWorkbook.Sheets
        On Error GoTo errHandler:
        Set qry = oSheet.ListObjects(1).QueryTable
        oCmbBox.AddItem oSheet.name

    ...
NextSheet:
    Next oSheet

...
Exit Sub

errHandler:
Resume NextSheet        
End Sub

---

还有另一种控制错误处理的方法对循环很有效。在此处创建名为

的字符串变量

，并使用该变量确定单个错误处理程序如何处理错误

代码模板为：

On error goto errhandler

Dim here as String

here = "in loop"
For i = 1 to 20 
    some code
Next i

afterloop:
here = "after loop"
more code

exitproc:    
exit sub

errhandler:
If here = "in loop" Then 
    resume afterloop
elseif here = "after loop" Then
    msgbox "An error has occurred" & err.desc
    resume exitproc
End if

---

我不想为代码中的每个循环结构设计特殊的错误处理程序，因此我有一种方法可以使用我的标准错误处理程序查找问题循环，这样我就可以为它们编写特殊的错误处理程序

如果循环中发生错误，我通常想知道是什么导致了错误，而不是跳过它。为了找出这些错误，我像许多人一样将错误消息写入日志文件。但是，如果循环中发生错误，则写入日志文件是危险的，因为每次循环迭代时都会触发错误，在我的情况下，80000次迭代并不少见。因此，我在我的错误日志函数中加入了一些代码，用于检测相同的错误并跳过将它们写入错误日志

我在每个过程中使用的标准错误处理程序如下所示。它记录错误类型、发生错误的过程以及过程接收到的任何参数（本例中为文件类型）

我的错误记录函数写入表（我在ms access中）如下所示。它使用静态变量来保留错误数据的先前值，并将它们与当前版本进行比较。第一个错误被记录，然后第二个相同的错误将应用程序推入调试模式（如果我是用户），或者如果处于其他用户模式，则退出应用程序

Public Function NewErrorLog(ErrCode As Variant, ErrDesc As Variant, Optional Source As Variant = "", Optional ErrData As Variant = Null) As Boolean
On Error GoTo errLogError

    'Records errors from application code
    Dim dbs As Database
    Dim rst As Recordset

    Dim ErrorLogID As Long
    Dim StackInfo As String
    Dim MustQuit As Boolean
    Dim i As Long

    Static ErrCodeOld As Long
    Static SourceOld As String
    Static ErrDataOld As String

    'Detects errors that occur in loops and records only the first two.
    If Nz(ErrCode, 0) = ErrCodeOld And Nz(Source, "") = SourceOld And Nz(ErrData, "") = ErrDataOld Then
        NewErrorLog = True
        MsgBox "Error has occured in a loop: " & Nz(ErrCode, 0) & Space(1) & Nz(ErrDesc, "") & ": " & Nz(Source, "") & "[" & Nz(ErrData, "") & "]", vbExclamation, Appname
        If Not gDeveloping Then  'Allow debugging
            Stop
            Exit Function
        Else
            ErrDesc = "[loop]" & Nz(ErrDesc, "")  'Flag this error as coming from a loop
            MsgBox "Error has been logged, now Quiting", vbInformation, Appname
            MustQuit = True  'will Quit after error has been logged
        End If
    Else
        'Save current values to static variables
        ErrCodeOld = Nz(ErrCode, 0)
        SourceOld = Nz(Source, "")
        ErrDataOld = Nz(ErrData, "")
    End If

    'From FMS tools pushstack/popstack - tells me the names of the calling procedures
    For i = 1 To UBound(mCallStack)
        If Len(mCallStack(i)) > 0 Then StackInfo = StackInfo & "\" & mCallStack(i)
    Next

    'Open error table
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset("tbl_ErrLog", dbOpenTable)

    'Write the error to the error table
    With rst
        .AddNew
        !ErrSource = Source
        !ErrTime = Now()
        !ErrCode = ErrCode
        !ErrDesc = ErrDesc
        !ErrData = ErrData
        !StackTrace = StackInfo
        .Update
        .BookMark = .LastModified
        ErrorLogID = !ErrLogID
    End With


    rst.Close: Set rst = Nothing
    dbs.Close: Set dbs = Nothing
    DoCmd.Hourglass False
    DoCmd.Echo True
    DoEvents
    If MustQuit = True Then DoCmd.Quit

exitLogError:
    Exit Function

errLogError:
    MsgBox "An error occured whilst logging the details of another error " & vbNewLine & _
    "Send details to Developer: " & Err.number & ", " & Err.Description, vbCritical, "Please e-mail this message to developer"
    Resume exitLogError

End Function

---

请注意，错误记录器必须是应用程序中最可靠的功能，因为应用程序无法优雅地处理错误记录器中的错误。出于这个原因，我使用NZ（）来确保null不能潜入。请注意，我还将[loop]添加到第二个相同的错误中，这样我就知道首先要查看错误过程中的循环。

难道没有不属于查询表的“列表对象”吗？我需要工作表有一个查询表。@Justin，如果有，请为

ListObjects（1）添加一个测试。QueryTable什么都不是
-您的代码也没有这个测试。我的示例的要点是在取消引用第一个元素之前检查ListObjects集合是否有任何元素。错误：没有错误的恢复对我来说是一个很好的提示！对我来说，重要的是要理解，由On Error Goto引用的行标签被视为一个错误处理例程。这些例程必须使用Resume、Exit sub、Exit function或Exit propoerty关闭。
procerr:
    Call NewErrorLog(Err.number, Err.Description, "GetOutputFileType", FileType)
    Resume exitproc

Public Function NewErrorLog(ErrCode As Variant, ErrDesc As Variant, Optional Source As Variant = "", Optional ErrData As Variant = Null) As Boolean
On Error GoTo errLogError

    'Records errors from application code
    Dim dbs As Database
    Dim rst As Recordset

    Dim ErrorLogID As Long
    Dim StackInfo As String
    Dim MustQuit As Boolean
    Dim i As Long

    Static ErrCodeOld As Long
    Static SourceOld As String
    Static ErrDataOld As String

    'Detects errors that occur in loops and records only the first two.
    If Nz(ErrCode, 0) = ErrCodeOld And Nz(Source, "") = SourceOld And Nz(ErrData, "") = ErrDataOld Then
        NewErrorLog = True
        MsgBox "Error has occured in a loop: " & Nz(ErrCode, 0) & Space(1) & Nz(ErrDesc, "") & ": " & Nz(Source, "") & "[" & Nz(ErrData, "") & "]", vbExclamation, Appname
        If Not gDeveloping Then  'Allow debugging
            Stop
            Exit Function
        Else
            ErrDesc = "[loop]" & Nz(ErrDesc, "")  'Flag this error as coming from a loop
            MsgBox "Error has been logged, now Quiting", vbInformation, Appname
            MustQuit = True  'will Quit after error has been logged
        End If
    Else
        'Save current values to static variables
        ErrCodeOld = Nz(ErrCode, 0)
        SourceOld = Nz(Source, "")
        ErrDataOld = Nz(ErrData, "")
    End If

    'From FMS tools pushstack/popstack - tells me the names of the calling procedures
    For i = 1 To UBound(mCallStack)
        If Len(mCallStack(i)) > 0 Then StackInfo = StackInfo & "\" & mCallStack(i)
    Next

    'Open error table
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset("tbl_ErrLog", dbOpenTable)

    'Write the error to the error table
    With rst
        .AddNew
        !ErrSource = Source
        !ErrTime = Now()
        !ErrCode = ErrCode
        !ErrDesc = ErrDesc
        !ErrData = ErrData
        !StackTrace = StackInfo
        .Update
        .BookMark = .LastModified
        ErrorLogID = !ErrLogID
    End With


    rst.Close: Set rst = Nothing
    dbs.Close: Set dbs = Nothing
    DoCmd.Hourglass False
    DoCmd.Echo True
    DoEvents
    If MustQuit = True Then DoCmd.Quit

exitLogError:
    Exit Function

errLogError:
    MsgBox "An error occured whilst logging the details of another error " & vbNewLine & _
    "Send details to Developer: " & Err.number & ", " & Err.Description, vbCritical, "Please e-mail this message to developer"
    Resume exitLogError

End Function