How to loop through sub-folders? - vba

Question

I have VBA code that returns external file details like path, type, last modified date, last created date etc. for files in a folder.
I want to return the details for files in the sub-folders of that folder.
Dim IRow
Sub ListFiles()
IRow = 11 'where you want your first row of data
Call ListMyFiles(Range("B5"), False) 'Where B5 is your filepath (eg, C:\)
End Sub
Sub ListMyFiles(MySourcePath, includesubfolders)
Dim xSubFolder As Object
Set MyObject = New FileSystemObject
Set mysource = MyObject.GetFolder(MySourcePath)
On Error Resume Next
For Each myfile In mysource.Files
icol = 1
Cells(IRow, icol).Value = myfile.Path
icol = icol + 1
Cells(IRow, icol).Value = myfile.Name
icol = icol + 1
Cells(IRow, icol).Value = myfile.Type
icol = icol + 1
Cells(IRow, icol).Value = myfile.DateLastModified
icol = icol + 1
Cells(IRow, icol).Value = myfile.DateCreated
icol = icol + 1
IRow = IRow + 1
Next
If xIsSubfolders Then
For Each xSubFolder In xFolder.subfolders
ListFilesInFolder xSubFolder.Path, True
Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub

Answer 1

I haven't tested this, but basically what you want is recursion. This is when you call the subroutine/function while in that function. Basically it's the subroutine calling itself every time it finds a subfolder.
Something like:
Dim IRow
Sub ListFiles()
IRow = 11 'where you want your first row of data
Call ListMyFiles(Range("B5"), False) 'Where B5 is your filepath (eg, C:\)
End Sub
Sub ListMyFiles(MySourcePath as string, includesubfolders as boolean)
Set MyObject = New FileSystemObject
Set mysource = MyObject.GetFolder(MySourcePath)
On Error Resume Next
For Each myfile In mysource.Files
icol = 1
Cells(IRow, icol).Value = myfile.Path
icol = icol + 1
Cells(IRow, icol).Value = myfile.Name
icol = icol + 1
Cells(IRow, icol).Value = myfile.Type
icol = icol + 1
Cells(IRow, icol).Value = myfile.DateLastModified
icol = icol + 1
Cells(IRow, icol).Value = myfile.DateCreated
icol = icol + 1
IRow = IRow + 1
Next
'Check if the subroutine was called to include subfolders
If includesSubFolders Then
'Loop through all of the subfolders in the FSO folder
For Each SubFolder in mysource.SubFolders
'Call this same subroutine
ListMyFiles(Subfolder.Path, true)
Next xSubFolder
End If
End Sub

Answer 2

A lot of things can be simplified here. More importantly, the folder transversing needs to be a recursive call in order to go through to all subfolder levels.
Here is a sample code that does this. The first argument to ListMyFiles is the cell location where the path is stored, and the second argument when you want the file list to start.
Sub ListFiles()
Call ListMyFiles(Sheet1.Range("B5"), Sheet1.Range("B11"), True)
End Sub
Sub ListMyFiles(ByVal r_SourcePath As Range, ByRef r_List As Range, Optional includesubfolders As Boolean = False)
Dim path As String, ff As Folder
path = r_SourcePath.Text
Dim fso As New FileSystemObject
Set ff = fso.GetFolder(path)
Call ListFileInFolder(r_List, ff, includesubfolders)
End Sub
Public Sub ListFileInFolder(ByRef r_List As Range, ByRef ff As Folder, Optional inclSubFolders As Boolean = False)
On Error Resume Next
Dim index As Long, n As Long
index = 0
Dim f As File
For Each f In ff.Files
r_List.Offset(index, 0).Resize(1, 5).Value2 = _
Array(f.path, f.Name, f.Type, f.DateLastModified, f.DateCreated)
index = index + 1
Next
If inclSubFolders Then
For Each ff In ff.SubFolders
n = ff.Files.Count
If n > 0 Then
Call ListFileInFolder(r_List.Offset(index, 0), ff, True)
index = index + n
End If
Next
End If
On Error GoTo 0
End Sub
Of note here is the writing of a single row of data of 5 columns using a single line and the Array() function.