Обработка ошибок vba в цикле

Ответ 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

Ответ 2

В качестве общего способа обработки ошибки в цикле, как ваш пример кода, я бы предпочел использовать:

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

Ответ 3

Как насчет:

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

Ответ 4

I, который может вам помочь, у меня есть следующая функция в моей "библиотеке". Поскольку это набор функций, которые я написал, и функции, которые я нашел в сети, я не очень уверен, откуда это происходит.

  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

Я не хочу создавать специальные обработчики ошибок для каждой структуры цикла в моем коде, поэтому у меня есть способ поиска циклов с использованием стандартного обработчика ошибок, чтобы затем я мог написать для них специальный обработчик ошибок.

Если в цикле возникает ошибка, я обычно хочу знать, что вызвало ошибку, а не просто пропустить ее. Чтобы узнать об этих ошибках, я пишу сообщения об ошибках в файл журнала, как это делают многие люди. Однако запись в файл журнала опасна, если в цикле возникает ошибка, так как ошибка может быть вызвана для каждого цикла цикла и в моем случае 80 000 итераций не является чем-то необычным. Поэтому я поместил некоторый код в свою функцию регистрации ошибок, которая обнаруживает идентичные ошибки и пропускает их запись в журнал ошибок.

Мой стандартный обработчик ошибок, который используется для каждой процедуры, выглядит следующим образом. Он записывает тип ошибки, процедуру, в которой произошла ошибка, и любые параметры, полученные процедурой (FileType в этом случае).

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

Моя функция регистрации ошибок, которая записывает в таблицу (я в ms-доступе), выглядит следующим образом. Он использует статические переменные для сохранения предыдущих значений данных ошибок и сравнения их с текущими версиями. Первая ошибка регистрируется, затем вторая идентичная ошибка подталкивает приложение в режим отладки, если я пользователь или в другом пользовательском режиме, завершает работу приложения.

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(), чтобы убедиться, что нули не могут проникнуть. Обратите внимание, что я также добавляю [цикл] ко второй идентичной ошибке, чтобы я знал, чтобы сначала просмотреть петли в процедуре ошибки.

Ответ 6

Это

On Error GoTo NextSheet:

Должно быть:

On Error GoTo NextSheet

Другое решение тоже хорошо.

Ответ 7

А что?

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

Ответ 8

Фактически, ответ 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

Ответ 9

Существует еще один способ управления обработкой ошибок, который хорошо работает для циклов. Создайте строковую переменную с именем 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