Trying to loop through subfolders and files within subfolders - vba

Question

I want to access a folder using VBA and loop through all Excel files in all subfolders. More specifically, I want to gather data from specific cells in each file and dump the data in my active workbook. Something i feel should be easy to write up but I've been unsuccessful so far. I've tried a few methods for looping through subfolders that I found online but they haven't helped.
Here's a visual idea of what I'd like to achieve:
Sub example()
'Find a way to enter file path
'Find a way to loop through subfolders
'Find a way to loop through excel files and refer to current file below
x = 2
Workbooks(Loop Test.xlsm).Worksheets("Sheet1").Cells(x,1) = 'current file in loop range A1
Workbooks(Loop Test.xlsm).Worksheets("Sheet1").Cells(x,2) = 'current file in loop range A2
' etc.
x = x + 1
' next file
End Sub

Answer 1

Writing a function to return the list of files will make testing easier.
Test
Sub TestGetFileList()
Dim f As Variant, fileList As Object
Set fileList = getFileList("C:\Level 1")
For Each f In fileList
Debug.Print f
Next
End Sub
getFileList:Function
Function getFileList(Path As String, Optional FileFilter As String = "*.xls?", Optional fso As Object, Optional list As Object) As Object
Dim BaseFolder As Object, f As Object
If fso Is Nothing Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set list = CreateObject("System.Collections.ArrayList")
'Set list = CreateObject("Scripting.Dictionary")
End If
If Not Right(Path, 1) = "\" Then Path = Path & "\"
If Len(Dir(Path, vbDirectory)) = 0 Then
MsgBox Path & " not found"
Exit Function
End If
Set BaseFolder = fso.GetFolder(Path)
For Each f In BaseFolder.SubFolders
getFileList f.Path, FileFilter, fso, list
Next
For Each f In BaseFolder.files
If f.Path Like FileFilter Then list.Add f.Path
Next
Set getFileList = list
End Function

Answer 2

Think I've got it:
Sub Test2()
Dim wb As Workbook, ws As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder("C:\Users\azrae\OneDrive\Desktop\To Be Transferred\Optimum\Test Folder\")
x = 2
For Each sfldr In fldr.SubFolders
For Each wbfile In sfldr.Files
If fso.getextensionname(wbfile.Name) = "xlsx" Then
Set wb = Workbooks.Open(wbfile.Path)
End If
Workbooks("Loop Test.xlsm").Worksheets("Sheet1").Cells(x, 1) = wb.Worksheets("Sheet1").Range("A1")
Workbooks("Loop Test.xlsm").Worksheets("Sheet1").Cells(x, 2) = wb.Worksheets("Sheet1").Range("A2")
Workbooks("Loop Test.xlsm").Worksheets("Sheet1").Cells(x, 3) = wb.Worksheets("Sheet1").Range("A3")
wb.Close
x = x + 1
Next wbfile
Next sfldr
End Sub
Let me know if you have a smoother method.