vba to skip corrupt files needed (Excel crashes when trying to open)

[Richard U]

We are upgrading to office 365 and excel 2016, and changing our directory structure.

As part of this, we need to document which spreadsheets have links. I am literally checking tens of thousands of files.

I created a crawler to scour the directories, open the files and documenting the links

 Application.DisplayAlerts = False
 Application.ScreenUpdating = False
 
    Dim currentPath As String, directory As Variant
    Dim dirCollection As Collection
    Set dirCollection = New Collection
    Dim wb As New Workbook
    Dim aLinks As Variant
    Dim lng As Long
    'Dim lng_ctr As Long
    currentPath = Dir(path, vbDirectory)
 Do Until currentPath = vbNullString
        Debug.Print currentPath
        If InStr(Right(currentPath, Len(currentPath) - InStrRev(currentPath, ".") + 1), ".xls") <> 0 Then
        'If Right(currentPath, 4) = ".xls" Then
            With ThisWorkbook.Sheets(1)
                On Error Resume Next
                Application.EnableEvents = False
                Set wb = Workbooks.Open(path & currentPath)
                If Err.Number <> 0 Then Set wb = Nothing
                Application.EnableEvents = True
                If Err.Number <> 0 Then
                    .Cells(lng_ctr, 1) = path
                    .Cells(lng_ctr, 2) = currentPath
                    .Cells(lng_ctr, 3) = "Could not open file"
                    .Cells(lng_ctr, 4) = "error number " & Err.Number
                    lng_ctr = lng_ctr + 1
                    On Error GoTo 0
                Else
                aLinks = wb.LinkSources(xlExcelLinks)
                
                    If Not IsEmpty(aLinks) Then
                    .Cells(lng_ctr, 1).Value = path
                        For lng = 1 To UBound(aLinks)
                            lng_ctr = lng_ctr + 1
                             .Cells(lng_ctr, 1).Value = path
                            .Cells(lng_ctr, 2).Value = currentPath
                            .Cells(lng_ctr, 3).Value = aLinks(lng)
                        Next lng
                    Else
                
                        .Cells(lng_ctr, 3).Value = "NO LINK FOUND"
                        .Cells(lng_ctr, 1).Value = path
                        .Cells(lng_ctr, 2).Value = currentPath
                        lng_ctr = lng_ctr + 1
                    End If
                wb.Close
                End If
                
            End With
        End If
    Loop

the problem comes when my crawler encounters a corrupt file. Excel crashes HARD and I lose everything.


I have tried error handling like this

                Application.EnableEvents = False
                Set wb = Workbooks.Open(path & currentPath)
                If Err.Number <> 0 Then Set wb = Nothing
                Application.EnableEvents = True

but it doesn't seem to be working.

It crashes right at this line:

  Set wb = Workbooks.Open(path & currentPath)

 

[RoryA]

You might try specifying the CorruptLoad:=xlextractdata (or xlrepairfile) argument for Workbooks.open.

 

[Richard U]

Thanks, but it didn't work. Excel still crashes. Great idea though.

I found the file, and it crashes excel if you try to repair it manually too, or try to just get the data.

Only choice is to scrap the file, I guess.