循环 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

如您所见，流程已经有点混乱，就像在 VBA 中经常使用 GoTo 一样。它基本上相当于假设的Try Catch：

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

与异常一样，通常最好明确检查您“预期”可能导致错误的合理条件，并在适当的情况下谨慎使用此类错误处理程序构造。