VBA，循环通过目录包含损坏的文件，绕过？

Question

我有一个宏，它遍历一个大的文件目录并执行一个任务。但是，当宏到达某个具有“不可读内容”的文件时，该宏将停止。(excel文件)

我可以在代码中添加什么来跳过这些文件？我的代码的哪个区域我应该放置它？

在声明变量之后，尝试将它添加到我的代码中，但是没有做任何事情。

On Error Resume Next 

非常感谢

编辑~

发布我的vba代码的一部分，只是一个注释：'UserInput‘是一个函数。如果你需要更多的张贴，以更好地理解，让我知道，我会张贴。

'get user input for files to search
Set fileNames = CreateObject("Scripting.Dictionary")
errCheck = UserInput.FileDialogDictionary(fileNames)
If errCheck Then
   Exit Sub
End If
'''
For Each Key In fileNames 'loop through the dictionary

Debug.Print fileNames(Key)
    Set wb = Workbooks.Open(fileNames(Key), CorruptLoad:=xlRepairFile)
    wb.Application.Visible = False 'make it not visible

编辑~

要上传完整的代码。这与建议的更改有关。

Sub ladiesman()
'includes filling down

Dim wb As Workbook, fileNames As Object, errCheck As Boolean
    Dim ws As Worksheet, wks As Worksheet, wksSummary As Worksheet
    Dim y As Range, intRow As Long, i As Integer
    Dim r As Range, lr As Long, myrg As Range, z As Range
    Dim boolWritten As Boolean, lngNextRow As Long
    Dim intColNode As Integer, intColScenario As Integer
    Dim intColNext As Integer, lngStartRow As Long

    Dim lngLastNode As Long, lngLastScen As Long

     ' Turn off screen updating and automatic calculation
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

     ' Create a new worksheet, if required
    On Error Resume Next
    Set wksSummary = ActiveWorkbook.Worksheets("Unique data")
    On Error GoTo 0
    If wksSummary Is Nothing Then
        Set wksSummary = ActiveWorkbook.Worksheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
        wksSummary.Name = "Unique data"
    End If

     ' Set the initial output range, and assign column headers
    With wksSummary
        Set y = .Cells(.Rows.Count, 3).End(xlUp).Offset(1, 0)
        Set r = y.Offset(0, 1)
        Set z = y.Offset(0, -2)
        lngStartRow = y.Row
        .Range("A1:D1").Value = Array("File Name", "Sheet Name", "Node Name", "Scenario Name")
    End With

'get user input for files to search
Set fileNames = CreateObject("Scripting.Dictionary")
errCheck = UserInput.FileDialogDictionary(fileNames)
If errCheck Then
   Exit Sub
End If
'''
For Each Key In fileNames 'loop through the dictionary




On Error Resume Next
Set wb = Workbooks.Open(fileNames(Key))
If Err.Number <> 0 Then
    Set wb = Nothing    ' or set a boolean error flag
End If
On Error GoTo 0    ' or your custom error handler

If wb Is Nothing Then
    Debug.Print "Error when loading " & fileNames(Key)
Else
    Debug.Print "Successfully loaded " & fileNames(Key)
    wb.Application.Visible = False 'make it not visible
    ' more working with wb
End If



 ' Check each sheet in turn
    For Each ws In ActiveWorkbook.Worksheets
        With ws
             ' Only action the sheet if it's not the 'Unique data' sheet
            If .Name <> wksSummary.Name Then
                boolWritten = False

                 ' Find the Scenario column
                intColScenario = 0
                On Error Resume Next
                intColScenario = WorksheetFunction.Match("scenarioName", .Rows(1), 0)
                On Error GoTo 0

                If intColScenario > 0 Then
                     ' Only action if there is data in column E
                    If Application.WorksheetFunction.CountA(.Columns(intColScenario)) > 1 Then
                         ' Find the next free column, in which the extract formula will be placed
                        intColNext = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1

                         ' Assign formulas to the next free column to identify the scenario name to the left of the first _ character
                        .Cells(1, intColNext).Value = "Test"
                        lr = .Cells(.Rows.Count, intColScenario).End(xlUp).Row
                        Set myrg = .Range(.Cells(2, intColNext), .Cells(lr, intColNext))
                        With myrg
                            .ClearContents
                            .FormulaR1C1 = "=IFERROR(LEFT(RC" & intColScenario & ",FIND(INDEX({""+"",""-"",""_"",""$"",""%""},1,MATCH(1,--(ISNUMBER(FIND({""+"",""-"",""_"",""$"",""%""},RC" & _
                            intColScenario & "))),0)), RC" & intColScenario & ")-1), RC" & intColScenario & ")"
                            .Value = .Value
                        End With

                         ' Copy unique values from the formula column to the 'Unique data' sheet, and write sheet & file details
                        .Range(.Cells(1, intColNext), .Cells(lr, intColNext)).AdvancedFilter xlFilterCopy, , r, True
                        r.Offset(0, -2).Value = ws.Name
                        r.Offset(0, -3).Value = ws.Parent.Name

                         ' Clear the interim results
                        .Range(.Cells(1, intColNext), .Cells(lr, intColNext)).ClearContents

                         ' Delete the column header copied to the list
                        r.Delete Shift:=xlUp
                        boolWritten = True
                    End If
                End If

                 ' Find the Node column
                intColNode = 0
                On Error Resume Next
                intColNode = WorksheetFunction.Match("node", .Rows(1), 0)
                On Error GoTo 0

                If intColNode > 0 Then
                     ' Only action if there is data in column A
                    If Application.WorksheetFunction.CountA(.Columns(intColNode)) > 1 Then
                        lr = .Cells(.Rows.Count, intColNode).End(xlUp).Row

                         ' Copy unique values from column A to the 'Unique data' sheet, and write sheet & file details (if not already written)
                        .Range(.Cells(1, intColNode), .Cells(lr, intColNode)).AdvancedFilter xlFilterCopy, , y, True
                        If Not boolWritten Then
                            y.Offset(0, -1).Value = ws.Name
                            y.Offset(0, -2).Value = ws.Parent.Name
                        End If

                         ' Delete the column header copied to the list
                        y.Delete Shift:=xlUp
                    End If
                End If

         ' Identify the next row, based on the most rows used in columns C & D
                lngLastNode = wksSummary.Cells(wksSummary.Rows.Count, 3).End(xlUp).Row
                lngLastScen = wksSummary.Cells(wksSummary.Rows.Count, 4).End(xlUp).Row
                lngNextRow = WorksheetFunction.Max(lngLastNode, lngLastScen) + 1
                If (lngNextRow - lngStartRow) > 1 Then



                     ' Fill down the workbook and sheet names
                    z.Resize(lngNextRow - lngStartRow, 2).FillDown
                    If (lngNextRow - lngLastNode) > 1 Then
                         ' Fill down the last Node value
                        wksSummary.Range(wksSummary.Cells(lngLastNode, 3), wksSummary.Cells(lngNextRow - 1, 3)).FillDown
                    End If
                    If (lngNextRow - lngLastScen) > 1 Then
                         ' Fill down the last Scenario value
                        wksSummary.Range(wksSummary.Cells(lngLastScen, 4), wksSummary.Cells(lngNextRow - 1, 4)).FillDown
                    End If
                End If



                Set y = wksSummary.Cells(lngNextRow, 3)
                Set r = y.Offset(0, 1)
                Set z = y.Offset(0, -2)
                lngStartRow = y.Row
            End If
        End With
    Next ws
wb.Close savechanges:=False 'close the workbook do not save
Set wb = Nothing 'release the object
Next 'End of the fileNames loop
Set fileNames = Nothing

 ' Autofit column widths of the report
wksSummary.Range("A1:D1").EntireColumn.AutoFit

' Reset system settings
With Application
   .Calculation = xlCalculationAutomatic
   .ScreenUpdating = True
   .Visible = True
End With
End Sub

Answer 1

如果您想跳过不可读的文件，您应该去掉CorruptLoad:=xlRepairFile (显然它对您的文件不起作用)，并在尝试打开文件之前直接使用On Error Resume Next。

如下所示：

On Error Resume Next
Set wb = Workbooks.Open(fileNames(Key))
If Err.Number <> 0 Then
    Set wb = Nothing    ' or set a boolean error flag
End If
On Error GoTo 0    ' or your custom error handler

If wb Is Nothing Then
    Debug.Print "Error when loading " & fileNames(Key)
Else
    Debug.Print "Successfully loaded " & fileNames(Key)
    wb.Application.Visible = False 'make it not visible
    ' more working with wb
    ' all
    ' your
    ' code
    ' goes
    ' here :)
End If

编辑

所有的代码

' Check each sheet in turn
For Each ws In ActiveWorkbook.Worksheets

(您应该在这里使用wb而不是ActiveWorkbook)

至

wb.Close savechanges:=False 'close the workbook do not save
Set wb = Nothing 'release the object

在(或者说)我的占位符注释之后(而不是)，属于其他部分。

' more working with wb

只有在工作簿已成功加载时，才应执行所有这些操作。

编辑2

关于wb和ActiveWorkbook

它提高了代码的健壮性，以尽可能避免使用ActiveWorkbook、ActiveSheet等，特别是在处理多个工作簿时。稍后对代码的一些更改可能会在您使用代码时使不同的工作簿处于活动状态，突然您的代码将失败。(这里可能不是这个函数，但这是一个普遍的经验法则。)

wb刚刚被分配到打开的工作簿

Set wb = Workbooks.Open(fileNames(Key))

因此，使用wb变量处理该工作簿是一个很好的实践。

对于跳过的文件：

而不是

Debug.Print "Error when loading " & fileNames(Key)

只需在字符串中收集它们

strErrorFiles = strErrorFiles & vbCrLf & fileNames(Key)

然后MsgBox这个字符串。但是请注意，MsgBox对它显示的文本数量有限制，所以如果可能有大量错误文件，最好将它们写到工作表中。