Loop each folder and subfolder to get values

Question

Any tips or improvement to speed my code? I'm looping each file in the specify folder and subfolders. I will open each file and get the values I need and copy it to my activesheet. It is taking quit some time, any tips to help?

FolderName = InputBox("Enter path", "Get File")
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder(FolderName)
Do While queue.Count > 0
 Set oFolder = queue(1)
 queue.Remove 1 'dequeue
 For Each oSubfolder In oFolder.SubFolders
 If UCase(oSubfolder.Name) <> "DO NOT USE" Then
 queue.Add oSubfolder 'enqueue
 Else
 End If
 Next oSubfolder
 Dim lastUsedRow As Long
 lastUsedRow = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row + 1
 For Each oFile In oFolder.Files
 'Process each file but exclude files such as "~xxxxxx" or thumbs.db or xxxx.tmp files
 If oFile.Type = "Microsoft Excel Worksheet" Then
 If Not oFile.Name Like "*~*" Then 
 Dim app As New Excel.Application
 Dim Filename As String
 Filename = oFile.Path
 app.Visible = False 'Visible is False by default, so this isn't necessary
 Dim book As Excel.Workbook
 Set book = app.Workbooks.Add(Filename)
 ActiveSheet.Range("A" & lastUsedRow) = oFile.Name
 ActiveSheet.Range("B" & lastUsedRow) = oFile.DateCreated
 ActiveSheet.Range("E" & lastUsedRow) = book.Sheets("mySheet").Range("D3").Value
 ActiveSheet.Range("F" & lastUsedRow) = book.Sheets("mySheet").Range("G12").Value
 ActiveSheet.Range("G" & lastUsedRow) = book.Sheets("mySheet").Range("C9").Value
 ActiveSheet.Range("H" & lastUsedRow) = book.Sheets("mySheet").Range("C13").Value
 book.Close SaveChanges:=False
 app.Quit
 Set app = Nothing
 lastUsedRow = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row + 1
 End If
 End If
 Next oFile
Loop

• Comintern: Other than some minor tweaks like With blocks, I doubt you're going to speed this up much - you're opening files so this is largely IO bound.
• Mathieu Guindon: You're creating a new Excel.Application instance for each file in the folder, as well as a new file altogether... is that intended? In any case, the app instance should be pulled out of the loop, and if the code is hosted in Excel then there's no need to even create an instance of it. As New is also interfering with the =Nothing assignment at the end.
• Mathieu Guindon: Depends what you need to do, but as a rule of thumb I see no need to re-instantiate Excel for every single file you want to process when you're already in Excel.
• Sᴀᴍ Onᴇᴌᴀ: Welcome To Code Review! I have rolled back your last edit. Please do not update the code in your question to incorporate feedback from answers, doing so goes against the Question + Answer style of Code Review. This is not a forum where you should keep the most updated version in your question. Please see what you may and may not do after receiving answers.

Answer 1

As Mathieu Guindon mentioned in the comments, the main slow down is that you are creating a new Excel.Application for each file. I would personally just use the current Application and turn off Application.ScreenUpdating.

Using an InputBox to prompt an user to enter a folder path is very prone to error. You should test if the folder exists.

FolderName = InputBox("Enter path", "Get File")
Do While Len(Dir(FolderName, vbDirectory)) = 0
 If Len(Dir(FolderName, vbDirectory)) = 0 Then
 If MsgBox("Do you wish to continue?", vbYesNo, "Invalid Folder") <> vbYes Then
 Exit Sub
 Else
 FolderName = InputBox("Enter path", "Get File")
 End If
 End If
Loop

Or better yet just use Application.FileDialog(msoFileDialogFolderPicker) to pick the folder. It's the right tool for the job.

Using an Array to collect the data and writing it to a range of cells in one operation is much faster the writing each piece of data to an individual cell.

Refactored Code

Here is how I would write the code. Notice that I created a subroutine to collect the files and another to get the Folder Path. This allows me to debug each part of the code separately.

Sub LoopFoldersAndXLFiles()
 Dim t As Double: t = Timer
 Const SheetName As Variant = 1
 Dim FileList As Collection
 addExcelFileList FileList
 If FileList.Count = 0 Then Exit Sub
 Dim oFile As Object, xlApp As New Excel.Application
 Dim r As Long
 Dim results() As Variant
 ReDim results(1 To FileList.Count, 1 To 8)
 For r = 1 To FileList.Count
 Set oFile = FileList(r)
 With xlApp.Workbooks.Add(oFile.Path)
 results(r, 1) = oFile.Name
 results(r, 2) = oFile.DateCreated
 results(r, 5) = .Sheets(SheetName).Range("D3").Value
 results(r, 6) = .Sheets(SheetName).Range("G12").Value
 results(r, 7) = .Sheets(SheetName).Range("C9").Value
 results(r, 8) = .Sheets(SheetName).Range("C13").Value
 .Close SaveChanges:=False
 End With
 Next
 xlApp.Quit
 With ActiveSheet
 With .Range("A" & .Rows.Count).End(xlUp).Offset(1)
 .Resize(UBound(results), UBound(results, 2)).Value = results
 End With
 End With
 Debug.Print Round(Timer - t, 2)
End Sub
Sub addExcelFileList(ByRef FileList As Collection, Optional FolderName As String, Optional fso As Object)
 If Len(FolderName) = 0 Then
 FolderName = getFolderPath
 If Len(FolderName) = 0 Then Exit Sub
 End If
 If FileList Is Nothing Then Set FileList = New Collection
 If fso Is Nothing Then Set fso = CreateObject("Scripting.FileSystemObject")
 Dim oFolder As Object, oSubfolder As Object
 Set oFolder = fso.GetFolder(FolderName)
 For Each oSubfolder In oFolder.SubFolders
 If UCase(oSubfolder.Name) <> "DO NOT USE" Then addExcelFileList FileList, oSubfolder.Path, fso
 Next
 Dim oFile As Object
 For Each oFile In oFolder.Files
 If oFile.Type = "Microsoft Excel Worksheet" And Not oFile.Name Like "*~*" Then FileList.Add oFile
 Next
End Sub
Function getFolderPath() As String
 With Application.FileDialog(msoFileDialogFolderPicker)
 .Title = "Select a Folder"
 .AllowMultiSelect = False
 .InitialFileName = Application.DefaultFilePath
 If .Show <> -1 Then Exit Function
 getFolderPath = .SelectedItems(1)
 End With
End Function

• ThisGuyJustNeedsHelp: this works but it's actually slower than what i have after I modified it to work. I will edit my post.