VBA, Looping through Directory contains corrupt file, bypass? - vba

Question

I have a macro that goes through a large directory of files and performs a task. However the macro stops when it gets to a certain file that has 'unreadable content'. (excel files)
What can I add to my code to skip these files? What area of my code do I place it?
Tried adding this to my code after i declare my variables, doesn't do anything though.
On Error Resume Next
Many thanks
EDIT~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Posting part of my vba code, just a note: 'UserInput' is a function. If you need more posted to better understand let me know and i'll post.
'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
EDIT~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Going to upload full code. This is with the recommended changes.
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

If you want to skip the unreadable file, you should get rid of CorruptLoad:=xlRepairFile (apparently it doesn't work for your files anyways), and use On Error Resume Next directly before trying to open the file.
Like this:
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
Edit
All the code from
' Check each sheet in turn
For Each ws In ActiveWorkbook.Worksheets
(you should use wb here instead of ActiveWorkbook)
to
wb.Close savechanges:=False 'close the workbook do not save
Set wb = Nothing 'release the object
belongs in the Else part directly after (or rather instead of) my placeholder comment
' more working with wb
All of this should only be done, if the workbook has been successfully loaded.
Edit 2
About wb vs ActiveWorkbook:
It improves the robustness of your code to avoid using ActiveWorkbook, ActiveSheet etc. as much as possible, especially when working with multiple workbooks. Some later changes to your code may make a different workbook active at the time you use it, and suddenly your code will fail. (Probably not in this function here, but it's a general rule of thumb.)
wb was just assigned to the opened workbook
Set wb = Workbooks.Open(fileNames(Key))
so it's good practice to use the wb variable for everything you do with that workbook.
For the skipped files:
Instead of
Debug.Print "Error when loading " & fileNames(Key)
simply collect them in a string
strErrorFiles = strErrorFiles & vbCrLf & fileNames(Key)
and later MsgBox that string. But note that MsgBox has a limit to the number of text it will show, so if there may be lots of error files, better write them to a sheet.