Finding all excel files with VBA in folders and their subfolders: error handling password protected files

[dougmarkham]

Hi Folks,

Our office manager wants to reduce the complexity of our office hard-drive as she feels there are too many sub-folders going to deep. Problem is, we have a large number of excel spreadsheets with VBA pointing to file locations. Therefore, I wish use VBA to be able to locate all VBA containing workbooks so that if necessary, I can amend any FilePath or FolderPath references in VBA controlled workbooks i.e., after the office folder structure has been 're-engineered'...

Basic problem:

I have found a macro that: a) searches folders and sub-folders and b) when if finds a wb with VBA, it adds the following to a worksheet: col 1 (Path); Col 2 (File Name); Col 3 (Hyperlink to file).
During testing, I identified the following issue: when a workbook is password protected without offering a read-only option, the code stops.

Please would you help me modify the RecursiveFolder macro below so that if it finds a password protected file, it skips checking for VBA and instead simply adds the file's Path, Filename and Hyperlink to the worksheet?

Kind regards,

Doug.

Full Code:

Option Explicit

Dim wksDest As Worksheet
Dim NextRow As Long

Sub ListFiles()

    Dim objFSO As Object
    
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual
Application.EnableEvents = False
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    Set wksDest = Worksheets("FilesWithMacros")
    
    wksDest.Range("A1").Value = "Path"
    wksDest.Range("B1").Value = "File Name"
    wksDest.Range("C1").Value = "Hyperlink"
    
    NextRow = wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp).Row + 1
    
    'Change the path to your folder, accordingly
    Call RecursiveFolder(objFSO, "S:\APS_Logistics", True)
    
    wksDest.Columns.AutoFit

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
    
End Sub

Sub RecursiveFolder(ByRef FSO As Object, ByVal MyPath As String, ByVal IncludeSubFolders As Boolean)

    Dim File As Object
    Dim Folder As Object
    Dim SubFolder As Object
    Dim Wkb As Workbook
    Dim VBC As Object
    Dim NumLines As Long
        
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual
Application.EnableEvents = False
        
    Set Folder = FSO.GetFolder(MyPath)
    
    For Each File In Folder.Files
        If Right(File.Name, 4) = ".xls" Or Right(File.Name, 4) = ".xlt" Or Right(File.Name, 5) = ".xlsm" Or Right(File.Name, 5) = ".xltm" Or Right(File.Name, 5) = ".xlsb" Or Right(File.Name, 5) = ".xlam" Then
            Set Wkb = Workbooks.Open(File.Path, Password:="", UpdateLinks:=xlUpdateLinksNever, Notify:=True)
            On Error Resume Next
            For Each VBC In Wkb.VBProject.VBComponents
                With VBC.CodeModule
                    NumLines = .CountOfLines - .CountOfDeclarationLines
                    If NumLines > 0 Then
                        wksDest.Cells(NextRow, "A").Value = Wkb.Path
                        wksDest.Cells(NextRow, "B").Value = File.Name
                        wksDest.Hyperlinks.Add anchor:=wksDest.Cells(NextRow, "C"), Address:=File.Path, TextToDisplay:=File.Name
                        NextRow = NextRow + 1
                        Exit For
                    End If
                End With
            Next VBC
            Wkb.Close savechanges:=False
        End If
    Next File
    
    If IncludeSubFolders Then
        For Each SubFolder In Folder.SubFolders
            Call RecursiveFolder(FSO, SubFolder.Path, True)
        Next SubFolder
    End If
    
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
    
End Sub

 

[Sunjinsak]

Hi Doug,

Try the following modification to your RecursiveFolder sub. It uses some rudimentary error handling to do what you ask. It's not the most elegant way of achieving this but it does work (at least in my tests) and is the best I can come up with for now.

The code determines the difference between a password protected workbook and a password protected VBA project within a workbook. I'm not sure if that's specifically what you're looking for but it made sense to me and you can easily amend/remove if necessary.

For the sake of example I've added some text to Column D of the worksheet where a password protected workbook/project is encountered. Obviously you may want to remove those lines for your actual project...

Sub RecursiveFolder(ByRef FSO As Object, ByVal MyPath As String, ByVal IncludeSubFolders As Boolean)

    Dim File As Object
    Dim Folder As Object
    Dim SubFolder As Object
    Dim Wkb As Workbook
    Dim VBC As Object
    Dim NumLines As Long
        
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual
Application.EnableEvents = False
        
    Set Folder = FSO.GetFolder(MyPath)
    
    For Each File In Folder.Files
        If Right(File.Name, 4) = ".xls" Or Right(File.Name, 4) = ".xlt" Or Right(File.Name, 5) = ".xlsm" Or Right(File.Name, 5) = ".xltm" Or Right(File.Name, 5) = ".xlsb" Or Right(File.Name, 5) = ".xlam" Then
            Set Wkb = Workbooks.Open(File.Path, Password:="", UpdateLinks:=xlUpdateLinksNever, Notify:=True)
            On Error GoTo err_handler 'Redirect code execution to the error handler to handle for specific errors
            For Each VBC In Wkb.VBProject.VBComponents
                With VBC.CodeModule
                    NumLines = .CountOfLines - .CountOfDeclarationLines
                    If NumLines > 0 Then
                        wksDest.Cells(NextRow, "A").Value = Wkb.Path
                        wksDest.Cells(NextRow, "B").Value = File.Name
                        wksDest.Hyperlinks.Add anchor:=wksDest.Cells(NextRow, "C"), Address:=File.Path, TextToDisplay:=File.Name
                        NextRow = NextRow + 1
                        Exit For
                    End If
                End With
            Next VBC
            Wkb.Close savechanges:=False
        End If
next_line: 'Use this label to resume the loop where we left off after handling for errors
    Next File
    
    If IncludeSubFolders Then
        For Each SubFolder In Folder.SubFolders
            Call RecursiveFolder(FSO, SubFolder.Path, True)
        Next SubFolder
    End If
    
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic

    Exit Sub
    
err_handler:
    If Err.Number = 50289 Then 'VBA project is password protected
        wksDest.Cells(NextRow, "A").Value = File.ParentFolder
        wksDest.Cells(NextRow, "B").Value = File.Name
        wksDest.Hyperlinks.Add anchor:=wksDest.Cells(NextRow, "C"), Address:=File.Path, TextToDisplay:=File.Name
        wksDest.Cells(NextRow, "D").Value = "VBA project is password protected"
        NextRow = NextRow + 1
        Wkb.Close savechanges:=False
        Err.Clear
        Resume next_line
    End If
    If Err.Number = 1004 Then 'Workbook is password protected
        wksDest.Cells(NextRow, "A").Value = File.ParentFolder
        wksDest.Cells(NextRow, "B").Value = File.Name
        wksDest.Hyperlinks.Add anchor:=wksDest.Cells(NextRow, "C"), Address:=File.Path, TextToDisplay:=File.Name
        wksDest.Cells(NextRow, "D").Value = "Unable to determine - workbook is password protected"
        NextRow = NextRow + 1
        Err.Clear
        Resume next_line
    End If
    
    
End Sub

Note: I haven't included any default error handling for other errors but that will be easy enough to implement if you need it.

 

[dougmarkham]

Hi Doug,

Try the following modification to your RecursiveFolder sub. It uses some rudimentary error handling to do what you ask. It's not the most elegant way of achieving this but it does work (at least in my tests) and is the best I can come up with for now.

The code determines the difference between a password protected workbook and a password protected VBA project within a workbook. I'm not sure if that's specifically what you're looking for but it made sense to me and you can easily amend/remove if necessary.

For the sake of example I've added some text to Column D of the worksheet where a password protected workbook/project is encountered. Obviously you may want to remove those lines for your actual project...

Sub RecursiveFolder(ByRef FSO As Object, ByVal MyPath As String, ByVal IncludeSubFolders As Boolean)

    Dim File As Object
    Dim Folder As Object
    Dim SubFolder As Object
    Dim Wkb As Workbook
    Dim VBC As Object
    Dim NumLines As Long
       
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlManual
Application.EnableEvents = False
       
    Set Folder = FSO.GetFolder(MyPath)
   
    For Each File In Folder.Files
        If Right(File.Name, 4) = ".xls" Or Right(File.Name, 4) = ".xlt" Or Right(File.Name, 5) = ".xlsm" Or Right(File.Name, 5) = ".xltm" Or Right(File.Name, 5) = ".xlsb" Or Right(File.Name, 5) = ".xlam" Then
            Set Wkb = Workbooks.Open(File.Path, Password:="", UpdateLinks:=xlUpdateLinksNever, Notify:=True)
            On Error GoTo err_handler 'Redirect code execution to the error handler to handle for specific errors
            For Each VBC In Wkb.VBProject.VBComponents
                With VBC.CodeModule
                    NumLines = .CountOfLines - .CountOfDeclarationLines
                    If NumLines > 0 Then
                        wksDest.Cells(NextRow, "A").Value = Wkb.Path
                        wksDest.Cells(NextRow, "B").Value = File.Name
                        wksDest.Hyperlinks.Add anchor:=wksDest.Cells(NextRow, "C"), Address:=File.Path, TextToDisplay:=File.Name
                        NextRow = NextRow + 1
                        Exit For
                    End If
                End With
            Next VBC
            Wkb.Close savechanges:=False
        End If
next_line: 'Use this label to resume the loop where we left off after handling for errors
    Next File
   
    If IncludeSubFolders Then
        For Each SubFolder In Folder.SubFolders
            Call RecursiveFolder(FSO, SubFolder.Path, True)
        Next SubFolder
    End If
   
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic

    Exit Sub
   
err_handler:
    If Err.Number = 50289 Then 'VBA project is password protected
        wksDest.Cells(NextRow, "A").Value = File.ParentFolder
        wksDest.Cells(NextRow, "B").Value = File.Name
        wksDest.Hyperlinks.Add anchor:=wksDest.Cells(NextRow, "C"), Address:=File.Path, TextToDisplay:=File.Name
        wksDest.Cells(NextRow, "D").Value = "VBA project is password protected"
        NextRow = NextRow + 1
        Wkb.Close savechanges:=False
        Err.Clear
        Resume next_line
    End If
    If Err.Number = 1004 Then 'Workbook is password protected
        wksDest.Cells(NextRow, "A").Value = File.ParentFolder
        wksDest.Cells(NextRow, "B").Value = File.Name
        wksDest.Hyperlinks.Add anchor:=wksDest.Cells(NextRow, "C"), Address:=File.Path, TextToDisplay:=File.Name
        wksDest.Cells(NextRow, "D").Value = "Unable to determine - workbook is password protected"
        NextRow = NextRow + 1
        Err.Clear
        Resume next_line
    End If
   
   
End Sub

Note: I haven't included any default error handling for other errors but that will be easy enough to implement if you need it.

Hi Sunjinsak,

Thanks for replying and helping me out. I have tested this yesterday and this morning.

I have run the modifications you made to the code: first using F8 to go through line-by-line and it seemed to partly work: i.e., password protection boxes are ignored.

However, I have had various issue happen, so I'll list them:

1) When running the macro (rather than using F8 to run line-by-line): after a while, excel stops responding and becomes unreactive.
2) Excel closes the workbook but another remains open
3) Occasionally in certain folders when running with F8, the code suddenly returned Run-time error 91: Object variable or With block variable not set.
The line of code which returned the error was:

 wksDest.Cells(NextRow, "A").Value = File.ParentFolder

i.e., from the "If Err.Number = 1004 Then" error handling if statement in the function. I moved the file excel was analyzing when the error occurred from its sub-folder to the folder path and that file didn't cause the same error.

I tested the macro on Test folders with limited numbers of files in them and it worked.
So I wonder if the following maybe giving these issues:

1) Somehow, excel's registry memory is being exceeded, or something else that would cause excel to become unresponsive when there are too many files or folders nested in folders for it to handle
2) Macros that run upon the wb opening doing their thing and closing all other workbooks including our model workbook
3) This I have no idea why the run-time error is happening.

Is there anything you can suggest to address these?

Kind regards,

Doug.

 

[Sunjinsak]

Hi Doug,

1) Try adding DoEvents after the line For Each File In Folder.Files like so...

    For Each File In Folder.Files
        DoEvents
        'Rest of the code remains unaltered...

See if it still locks up and stops responding. I suspect it's simply because you have a lot of directories with a lot of files within them.

2) So Excel is closing the workbook from which your code is running? Curious. If that's the case then the other workbook remaining open is likely because your code is being interrupted before the line Wkb.Close savechanges:=False is being executed. I'm not sure why this is happening. The line Application.EnableEvents = False should suppress any Workbook_Open() events in the other workbooks from firing.

3) I suspect the problem specifically lies with the File.ParentFolder part of that line. If the File object is empty then that would cause a run-time error 91 to occur. The questions is; why would the File object be empty? Is there anything particularly different about the file Excel is analysing when this error occurs? How deep is the file nested in the folder structure?