vba subfolders
' List of subfolders
' Needs to add "Microsoft Scripting Runtime" reference to your file
Sub SubFoldersInfo(ByVal pFolder As String, ByRef pColFolders As Collection, _
Optional ByVal pMe As Boolean)
Dim sFolder As String
Dim oFSO As New FileSystemObject
Dim oFolder, oSubFolder As Folder
sFolder = IIf(Right(pFolder, 1) <> "\", pFolder & "\", pFolder)
Set oFolder = oFSO.GetFolder(sFolder)
If pMe Then
pColFolders.Add oFolder
End If
For Each oSubFolder In oFolder.SubFolders
pColFolders.Add oSubFolder
SubFoldersInfo oSubFolder.Path, pColFolders, False
Next
End Sub
'------------------------------------------------------------------------------
Sub TestMe()
Dim colFolders As New Collection, sFolderPath As Variant
SubFoldersInfo ThisWorkbook.Path, colFolders, True
For Each sFolderPath In colFolders
Debug.Print sFolderPath.ShortName & " : "; sFolderPath.Path
Next sFolderPath
End Sub