Traverse subdirectories and open files in those directories

Question

SOLVED: Fixed the scanning on C:\ problem -

this was actually caused by code that defined FolderPath, which was pulled using Range("L4").Value but should have been

ThisWorkbook.Sheets("Database").Range("L4").Value

So there was actually nothing wrong with the below code. Apologies for not giving you all complete information!

I'm trying to write some VBA code that does the following:

Finds all *.xlsx and *.xlsm files in specified path and subdirectories
Opens each one read-only
Copies the contents to the current spreadsheet, then closes file
Loops through all files

And I am currently losing my mind trying to do this. The closest I've been able to get is derived from code that was posted here a while back, as follows (where FolderPath is simply "C:\Path\To\Folder\"):

Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder(FolderPath)
    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1
        For Each oSubfolder In oFolder.SubFolders
            queue.Add oSubfolder
        Next oSubfolder
        For Each oFile In oFolder.Files
            Length = InStrRev(oFile, "\")
            oFileWB = Right(oFile, Len(oFile) - Length)
                'Open the given .xls* file read-only and suppress link update prompt
                Workbooks.Open FileName:=oFile, ReadOnly:=True, UpdateLinks:=False
                'Get current first empty row of database as first target row
                ftr = ThisWorkbook.Worksheets("Database").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                'Copy range from target sheet, from hardcoded cell A7 to AE in the bottom-most occupied row
                Workbooks(oFileWB).Sheets("Target Sheet").Range("A7:AE" & Workbooks(oFileWB).Sheets("Target Sheet").Cells(Rows.Count, 1).End(xlUp).Row).Copy
                'Paste above range into the first empty cell of the database
                ThisWorkbook.Worksheets("Database").Range(ThisWorkbook.Worksheets("Database").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Address).PasteSpecial xlPasteValues
                'Get last row of current database after copying data
                ltr = ThisWorkbook.Worksheets("Database").Cells(Rows.Count, 1).End(xlUp).Row
                'Copy date and filepath of sheet into all rows
                ThisWorkbook.Worksheets("Database").Range("AF" & ftr & ":AF" & ltr).Value = Now()
                ThisWorkbook.Worksheets("Database").Range("AG" & ftr & ":AG" & ltr).Value = oFile
            'Close current file and suppress save changes prompt
            Workbooks(oFileWB).Close savechanges:=False
    Next oFile
    Loop

This works perfectly well when nothing is open in those directories. But when one of the files in those directories is locked, it freaks out and starts scanning files in "C:\" instead of "C:\Path\To\Folder\". This then gives a permission error because it tries to open hiberfile.sys. This is a fairly critical problem for me because this script (a) needs to act in an entirely read-only manner, and (b) any files in these directories may be locked at any given time.

Has anyone got any idea how I can fix this? Also as a lesser issue - any idea how I can restrict it to opening *.xlsx and *.xlsm files, as currently it tries to open absolutely everything in those directories?

Thanks in advance

You can wrap the `Open()` call in an error handler, and restrict the file types using `If oFile.Name like "*.xls*"` Also, when opening files you should use the full path to the file, not just the file name. — Tim Williams, May 13 '20 at 00:09
Thanks, that worked perfectly! I've fixed the other problem described in OP so I'm going to mark this as solved. — spleeharvester, May 13 '20 at 00:36
Now that you have solved your own problem, you could/should actually put the "solved" part as an answer, and then accept that answer as the solution, instead of putting the solution in the question and then leaving the question open... (you wont get any points for answering your own question, but that's technically how this site works, not by putting "solved" in the question.) — braX, May 13 '20 at 00:49
Okay thank you, I'll do that now (though it's telling me to wait 2 days) — spleeharvester, May 13 '20 at 00:55
Wait to days? hmmm not sure why, unless maybe it's because your account is new... but i'm sure you will be back in a couple of days anyway, and it will probably remind you — braX, May 13 '20 at 01:04

score 1 · Accepted Answer · answered May 13 '20 at 00:57

SOLVED: Fixed the scanning on C:\ problem -

this was actually caused by code that defined FolderPath, which was pulled using Range("L4").Value but should have been

ThisWorkbook.Sheets("Database").Range("L4").Value

So there was actually nothing wrong with the below code. Apologies for not giving you all complete information!

The issue of specifying .xls files was fixed using the idea provided by Tim in the above comments.

Traverse subdirectories and open files in those directories

1 Answers1