0

I'm trying to write 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

The closest I've been able to get is derived from Loop Through All Subfolders Using VBA, where FolderPath is "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 when nothing is open in those directories.

When one of the files is locked, it starts scanning files in "C:" instead of "C:\Path\To\Folder". This gives a permission error because it tries to open hiberfile.sys. This is a critical problem because this script (a) needs to act in an entirely read-only manner, and (b) files in these directories may be locked at any given time.

Also as a lesser issue - how can I restrict it to opening *.xlsx and *.xlsm files?

Community
  • 1
  • 1
spleeharvester
  • 11
  • 4
  • 1
    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
  • 1
    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

1 Answers1

1

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.

spleeharvester
  • 11
  • 4