VBA: List of folder paths, return list of excel file paths, then edit excels

Question

I have a user-form that pastes folder-paths into a list. I then have the code below that is supposed to loop through that list and list all the sub-folders (then I'll probably have another code loop through the sub-folders to get the excel workbooks).

I know it's inelegant, because ultimately what I want is have my list of paths be looked in one a time, through each folder and subfolder to find and list the excel files. But there was a question like that and it was taken down. The question was then referred to a different q&a that I did not understand, that had to do with individual FILE NAMES, typed in a single cell not a range, nor as a path. I speak Russian, which some of his code was in, and still couldn't quite understand what his code meant and was referring to, and when I tried it, it kept telling met that "GetData" was undefined? so I've tried to ask a different but similar question in the hope that someone can explain to me what I need to do, as I've gone as far as I can and have tried to adapt both codes from the links in this post as well as many others. I have several modules with broken code that doesn't work, and the closest I've come is the code below. At this point I'd settle simply for a way to list the excel file names from a list of paths.

Option Explicit
Dim i As Long, j As Long
Dim searchfolders As Variant
Dim FileSystemObject

Sub ListOfFolders77()
Dim LookInTheFolder As String
'Dim ws As Worksheet: Set ws = Sheets("Output4")
Dim ws2 As Worksheet: Set ws2 = Sheets("Output3")
Dim rng As Range: Set rng = ws2.Range("A1:A" & Rows.Count).End(xlUp)
Dim mypath As Range
'Dim Region As Range: Set Region = ws.Range("A2")
'Dim district As Range: Set district = ws.Range("B2")
'Dim city As Range: Set city = ws.Range("C2")
'Dim atlas As Range: Set atlas = ws.Range("D2")

i = 1
For Each mypath In rng
    LookInTheFolder = mypath.Value
    Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
    For Each searchfolders In FileSystemObject.GetFolder(LookInTheFolder).subfolders
        Sheets("Subfolders").Cells(i, 1) = searchfolders
        i = i + 1
        SearchWithin searchfolders
    Next searchfolders
Next mypath

End Sub

Sub SearchWithin(searchfolders)
On Error GoTo exits
For Each searchfolders In FileSystemObject.GetFolder(searchfolders).subfolders
j = UBound(Split(searchfolders, "\"))
Cells(i, j) = searchfolders
i = i + 1
SearchWithin searchfolders
Next searchfolders
exits:
End Sub

Ideally I want to get all the excel files in the folders and subfolders, and copy paste the data on the first sheet into one long list, but I'm still on step 1. I posted a more detailed explanation here last week and have yet to receive any feedback or potential tips.

I apologize if this doesn't make sense or seems half-hazard. I am self taught in excel VBA and am struggling to understand if what I need is even possible. I attempted using Directory but I've little success putting directory in a for each loop. I also tried using an array, which almost crashed by computer as it went to list ALL the folders and files in my entire computer.

Answer 1

Here's a quick way, slightly adapted from this answer.

Just add in your folder locations to the path() = ... list and it should work for you. It outputs, in the current excel sheet, the paths of all Excel files in folders you provide.

From there, you can do what you please. (Perhaps throw the file paths in to an array, so you have an array of files you want to open. From there you can do the copying of data).

'Force the explicit delcaration of variables
Option Explicit

Sub ListFiles()
'http://www.xl-central.com/list-the-files-in-a-folder-and-subfolders.html
'Set a reference to Microsoft Scripting Runtime by using
'Tools > References in the Visual Basic Editor (Alt+F11)

'Declare the variables
Dim objFSO  As Scripting.FileSystemObject
Dim objTopFolder As Scripting.Folder
Dim strTopFolderName As String

Dim path()  As Variant ' EDIT THE BELOW PATH LIST FOR WHATEVER YOU NEED!
path() = Array("C:\Users\USERNAME\Desktop\Stuff\New folder", "C:\Users\USERNAME\Desktop\Other Stuff\")

'Insert the headers for Columns
Range("A1").Value = "File Name"
Range("D1").Value = "File Path"

Dim i       As Long
For i = LBound(path) To UBound(path)
    strTopFolderName = path(i)
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Get the top folder
    Set objTopFolder = objFSO.GetFolder(strTopFolderName)
    'Call the RecursiveFolder routine
    Call RecursiveFolder(objTopFolder, True)
    'Change the width of the columns to achieve the best fit
    Columns.AutoFit
Next i
End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder, _
                    IncludeSubFolders As Boolean)

'Declare the variables
Dim objFile As Scripting.File
Dim objSubFolder As Scripting.Folder
Dim NextRow As Long

'Find the next available row
NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1

'Loop through each file in the folder
For Each objFile In objFolder.Files
    Debug.Print (objFile)
    If objFile.Type = "Microsoft Excel Worksheet" Then
        Cells(NextRow, "A").Value = objFile.Name
        Cells(NextRow, "D").Value = objFile.path
        NextRow = NextRow + 1
    End If
Next objFile

'Loop through files in the subfolders
If IncludeSubFolders Then
    For Each objSubFolder In objFolder.SubFolders
        Call RecursiveFolder(objSubFolder, True)
    Next objSubFolder
End If

End Sub

Answer 2

If I understand correctly, your requirements are as follows:

• Begin with a set of root paths
• Iterate recursively through all the files in each root path
• For each file in the resulting collection, if it's an Excel file, add to final list for further processing

Let's start with the first two points. I would suggest the following code (make sure to add a reference to Microsoft Scripting Runtime via Tools -> References... in the VBA editor menus):

Public Function GetFiles(ByVal roots As Variant) As Collection
    Select Case TypeName(roots)
        Case "String", "Folder"
            roots = Array(roots)
    End Select

    Dim results As New Collection
    Dim fso As New Scripting.FileSystemObject

    Dim root As Variant
    For Each root In roots
        AddFilesFromFolder fso.GetFolder(root), results
    Next

    Set GetFiles = results
End Function

Private Sub AddFilesFromFolder(folder As Scripting.folder, results As Collection)
    Dim file As Scripting.file
    For Each file In folder.Files
        results.Add file
    Next

    Dim subfolder As Scripting.folder
    For Each subfolder In folder.SubFolders
        AddFilesFromFolder subfolder, results
    Next
End Sub

The GetFiles function can be called by passing in a single string (or Folder):

Debug.Print GetFiles("c:\users\win8\documents").Count

or anything that can be iterated over with For Each -- an array, collection, Dictionary, or even an Excel Range object:

Dim allFiles As Collection
Set allFiles = GetFiles(ws2.Range("A1:A" & Rows.Count).End(xlUp)) 'from question

---

GetFiles as it stands is flexible for many use cases, and doesn't use any Excel-specific objects. In order to limit the results to Excel files only, you can create a new collection, and only add the Excel files into the new collection:

'You could filter by the File object's Type property
Sub GetExcelFilesByType()
    Dim allFiles As Collection
    Set allFiles = GetFiles(ws2.Range("A1:A" & Rows.Count).End(xlUp)) 'from question

    Dim excelFiles As New Collection
    Dim file As Scripting.File
    For Each file In allFiles
        If file.Type = "Microsoft Excel Worksheet" Then excelFiles.Add file
    Next
End Sub

' Or you could filter by extension, using the FileSystemObject.GetExtensionName method
Sub GetExcelFilesByExtensionName()
    Dim allFiles As Collection
    Set allFiles = GetFiles(ws2.Range("A1:A" & Rows.Count).End(xlUp)) 'from question

    Dim excelFiles As New Collection
    Dim fso As New Scripting.FileSystemObject
    Dim file As Scripting.File
    For Each file In allFiles
        Select Case fso.GetExtensionName(file.path)
            Case "xls", "xlsb", "xlsm"
                excelFiles.Add file
        End Select
    Next
End Sub

Either will get you a Collection of File objects, of only Excel files, from the set of root folders.

---

Notes

• This code is recursively adding all the files (not just Excel files) into one collection (in GetFiles) and then filtering out the non-Excel files into a new collection. This might be less performant than adding only Excel files into the original collection, but that would limit GetFiles to only this scenario.
• If you want to paste the results into an Excel worksheet, you could iterate through excelFiles and paste each path into the sheet. Alternatively, you might convert excelFiles into an array, and use the Excel Range object's Value property to set all the values from the array, without using a For Each.

---

References

Microsoft Scripting Runtime

• FileSystemObject object, GetExtensionName method
• File object
• Folder object

VBA

• Collection object