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 

所屬的else部分後直接（或相當代替）我的佔位評論

' more working with wb 

所有這一切只應做，如果工作簿已成功加載。

---

編輯2

關於wb VS 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對顯示的文本數量有限制，所以如果可能有很多錯誤文件，最好將它們寫入表單。