Обработчик ошибок для циклического скребка книг Excel

Question

Я работаю над кодом, чтобы очистить несколько книг для одного значения ячейки и импортировать это значение в главную электронную таблицу. Код, который у меня ниже, отлично работает, когда он работает, но я обнаружил, что есть несколько книг, в которых могут быть проблемы из-за блокировки или какой-либо другой проблемы, которая приводит к ошибке, которая останавливает код. Я хотел бы использовать команду On error resume next, чтобы продолжить импорт значений из других книг, но мне нужен способ регистрировать книги, которые были пропущены из-за ошибки, чтобы значения можно было извлечь вручную (в идеале отдельный рабочий лист в основной книге). Вот код, который у меня есть:

Sub CopyRange()
Application.ScreenUpdating = False
Dim wkbDest As Workbook, sh As Worksheet
Dim wkbSource As Workbook
Set wkbDest = ThisWorkbook
Dim LastRow As Long

Const strPath As String = "E:\Desktop\Example\"
    ChDir strPath
strExtension = Dir(strPath & "*.xls*")

Do While strExtension <> ""
    Set wkbSource = Workbooks.Open(strPath & strExtension)
    With wkbSource
    On Error Resume Next
       'locate last row to start copying new value from the next spreadsheet
        LastRow = wkbDest.Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
        'From the Basis & Credits cell AB46, copy to last row+1 in the Master sheet starting in row A2
        .Sheets("Basis & Credits").Range("AB46").Copy
         wkbDest.Sheets("Master").Range("A" & LastRow).PasteSpecial Paste:=xlPasteValues
        .Close savechanges:=False
    End With
    strExtension = Dir
Loop
Application.ScreenUpdating = True

End Sub

Answer 1

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

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook, sh As Worksheet
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    
    'you need to create this worksheet named "Log"
    Dim LogSheet As Worksheet
    Set LogSheet = ThisWorkbook.Worksheets("Log")
    'clear contents in log sheet
    LogSheet.UsedRange.ClearContents
    
    Const strPath As String = "E:\Desktop\Example\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xls*")
    
    Do While strExtension <> ""
        path = strPath & strExtension
        If VerifyTasks(strPath & strExtension, wkbDest) Then
            LogSheet.Range("A" & LogSheet.Rows.Count).End(xlUp).Offset(1, 0).Value = strPath & strExtension & "  " & "succeeded"
        Else
            LogSheet.Range("A" & LogSheet.Rows.Count).End(xlUp).Offset(1, 0).Value = strPath & strExtension & "  " & "Failed"
        End If
        On Error GoTo 0
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True

End Sub

Function VerifyTasks(path As String, ByRef wkbDest As Workbook) As Boolean
    On Error GoTo errorhandler:
    Dim wkbSource As Workbook
    Set wkbSource = Workbooks.Open(path)
    With wkbSource
       'locate last row to start copying new value from the next spreadsheet
        LastRow = wkbDest.Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
        'From the Basis & Credits cell AB46, copy to last row+1 in the Master sheet starting in row A2
        .Sheets("Basis & Credits").Range("AB46").Copy
         wkbDest.Sheets("Master").Range("A" & LastRow).PasteSpecial Paste:=xlPasteValues
        .Close savechanges:=False
    End With
    VerifyTasks = True
    Call closeWorkbook(wkbSource)
    Exit Function
errorhandler:
    Call closeWorkbook(wkbSource)
    VerifyTasks = False
End Function

Sub closeWorkbook(ByRef xWb As Workbook)
    If Not xWb Is Nothing Then
        Application.DisplayAlerts = False
        xWb.Close
        Application.DisplayAlerts = True
    End If
End Sub

Answer 2

On Error Resume Next возобновляет выполнение со следующей строки кода, в основном «скрывая» возникновение ошибки, так что у вас не будет шансов на регистрацию.

Вероятно, вам нужно On Error GoTo [Label] . На этикетке вы можете вызвать процедуру регистрации ошибок. Если ошибки нет, вы пропускаете обработчик ошибок.

Do While condition
  On Error GoTo ErrorHandler
  
  ' Do Stuff

  GoTo NoError
  ErrorHandler:

  ' Log error

  NoError:
Loop

Как видите, поток уже немного запутан, как это часто бывает с GoTo в VBA. Это в основном эквивалент гипотетического Try Catch, хотя:

Do While condition
  Try
    ' Do Stuff
  Catch
    ' Log error
  End Try
Loop

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