Function getTargetFolders(ByVal strDirectoryPath As String) As String()
Dim buf As String
Dim i As Long: i = 0
Dim folders() As String: ReDim folders(0)
Dim nowPath As String
folders(0) = strDirectoryPath
Do
nowPath = folders(i) & "\"
buf = Dir(nowPath, vbDirectory)
Do While buf <> ""
If GetAttr(nowPath & buf) = vbDirectory _
And buf <> "." And buf <> ".." Then
ReDim Preserve folders(UBound(folders) + 1)
folders(UBound(folders)) = nowPath & buf
End If
buf = Dir()
Loop
If i = UBound(folders) Then
Exit Do
Else
i = i + 1
End If
Loop
getTargetFolders = folders
End Function
参考:
Dir関数で全サブフォルダの全ファイルを取得|ExcelマクロVBAサンプル集