vba error handling in loop

问题:

New to vba, trying an 'on error goto' but, I keep getting errors 'index out of range'.

I just want to make a combo box that is populated by the names of worksheets which contain a querytable.

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

NextSheet:
    Next oSheet

I'm not sure whether the problem is related to nesting the On Error GoTo inside a loop, or how to avoid using the loop.

回答1:

The problem is probably that you haven't resumed from the first error. You can't throw an error from within an error handler. You should add in a resume statement, something like the following, so VBA no longer thinks you are inside the error handler:

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

回答2:

As a general way to handle error in a loop like your sample code, I would rather use:

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

回答3:

How about:

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

回答4:

I that can help you, I have the following function in my "library". Since it's a mix of functions I wrote and functions I found on the net, I am not very sure where that one comes from.

  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

回答5:

I do not want to craft special error handlers for every loop structure in my code so I have a way of finding problem loops using my standard error handler so that I can then write a special error handler for them.

If an error occurs in a loop, I normally want to know about what caused the error rather than just skip over it. To find out about these errors, I write error messages to a log file as many people do. However writing to a log file is dangerous if an error occurs in a loop as the error can be triggered for every time the loop iterates and in my case 80 000 iterations is not uncommon. I have therefore put some code into my error logging function that detects identical errors and skips writing them to the error log.

My standard error handler that is used on every procedure looks like this. It records the error type, procedure the error occurred in and any parameters the procedure received (FileType in this case).

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

My error logging function which writes to a table (I am in ms-access) is as follows. It uses static variables to retain the previous values of error data and compare them to current versions. The first error is logged, then the second identical error pushes the application into debug mode if I am the user or if in other user mode, quits the application.

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

Note that an error logger has to be the most bullet proofed function in your application as the application cannot gracefully handle errors in the error logger. For this reason, I use NZ() to make sure that nulls cannot sneak in. Note that I also add [loop] to the second identical error so that I know to look in the loops in the error procedure first.

回答6:

This

On Error GoTo NextSheet:

Should be:

On Error GoTo NextSheet

The other solution is good too.

回答7:

What about?

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

Or

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

回答8:

Actualy the Gabin Smith's answer needs to be changed a bit to work, because you can't resume with without an error.

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

回答9:

There is another way of controlling error handling that works well for loops. Create a string variable called here and use the variable to determine how a single error handler handles the error.

The code template is:

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