在回路中的vba错误处理

Question

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或如何避免使用循环相关。

Answer 1

这个问题可能是你还没有从第一个错误恢复。您不能在错误处理程序中抛出错误。您应该添加在简历中声明，类似于以下，所以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 

Answer 2

如何：

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

Answer 3

这

On Error GoTo NextSheet: 

应该是：

On Error GoTo NextSheet 

的其他解决办法也很好。

Answer 4

我可以帮助你，我在我的“图书馆”有以下功能。既然它是我在网上发现的功能和功能的组合，我不太确定那个功能是从哪里来的。

Function GetTabList(Optional NameSpec As String = "*", _ 
       Optional wkb As Workbook = Nothing) As Variant 
    ' Returns an array of tabnames that match NameSpec 
    ' If no matching tabs are found, it returns False 

     Dim TabArray() As Variant 
     Dim t As Worksheet 
     Dim i As Integer 

     On Error GoTo NoFilesFound 
     If wkb Is Nothing Then Set wkb = ActiveWorkbook 
     ReDim TabArray(1 To wkb.Worksheets.Count) 
     i = 0 
     ' Loop until no more matching tabs are found 
     For Each t In wkb.Worksheets 
      If UCase(t.Name) Like UCase(NameSpec) Then 
       i = i + 1 
       TabArray(i) = t.Name 
      End If 
     Next t 
     ReDim Preserve TabArray(1 To i) 
     GetTabList = TabArray 
     Exit Function 

     ' Error handler 
    NoFilesFound: 
     GetTabList = False 
    End Function 

Answer 5

至于处理错误在喜欢你的示例代码回路一般的方式，我宁愿使用：

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

Answer 6

怎么样？

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

或者

If oSheet.ListObjects.Count > 0 Then 
    '// Source type 3 = xlSrcQuery 
    If oSheet.ListObjects(1).SourceType = 3 Then 
     oCmbBox.AddItem oSheet.Name 
    End IF 
End IF 

Answer 7

Actualy的加宾史密斯的答案需要修改一下工作，因为你可以”继续而没有错误。

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 

Answer 8

还有另一种控制错误处理的方法，可以很好地处理循环。创建一个名为here的字符串变量，并使用该变量确定单个错误处理程序如何处理错误。

的代码模板是：

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 

Answer 9

我不想手艺特殊的错误处理程序在我的代码每次循环结构，所以我必须找到问题的办法用我的标准错误处理回路，让我能然后为它们写一个特殊的错误处理程序。

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

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

procerr: 
    Call NewErrorLog(Err.number, Err.Description, "GetOutputFileType", FileType) 
    Resume exitproc 

写入表（我在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（）来确保空值不能潜入。注意，我还将[loop]添加到第二个相同的错误，以便我知道首先在错误过程中查找循环。