Как получить список папок в заданной директории

Dim Folders() As String
Sub Subfolders_in(Folder$)
    Dim N%
    Dim fs, f, f1, fc
 
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(Folder)
    Set fc = f.SubFolders
 
    N = 0
    On Local Error Resume Next
    For Each f1 In fc
      N = N + 1
      ReDim Preserve Folders(1 To N) As String
      Folders(N) = Folder & "\" & f1.Name & "\"
   Next f1
End Sub

Sub Dirs()
Dim myName$, myPath$, N%, Folders$()
On Local Error Resume Next
myPath = InputBox("Введите директорию", , "c:\temp\")
If Right(myPath, 1) <> "\" Then myPath = myPath & "\"
If Dir(Left(myPath, Len(myPath) - 1), 16) = "" Then MsgBox "Папка не существует!": Exit Sub
myName = Dir(myPath, vbDirectory)
Do While myName <> ""
  If GetAttr(myPath & myName) = vbDirectory And myName <> "." Then
    N = N + 1
    ReDim Preserve Folders$(1 To N)
    Folders(N) = myPath & myName
  End If
  myName = Dir()
Loop
MsgBox Join(Folders, vbLf)
End Sub

Option Explicit
 
Function Get_DirS(path As String)
Dim a() As String, D As String, U As Long
D = Dir(path, vbDirectory)
While D <> ""
  If GetAttr(path & "\" & D) And vbDirectory Then
    ReDim Preserve a(U)
    a(U) = path & D
    U = U + 1
  End If
  D = Dir
Wend
Get_DirS = a
End Function
 
Sub Get_DirS_Example()
Dim a
a = Get_DirS("C:\Documents and Settings\")
End Sub

If GetAttr(myPath & myName) = vbDirectory And myName <> "."  And myName <> ".." Then

D = Dir(path, vbDirectory Or vbHidden Or vbSystem)
While D <> ""
  If GetAttr(path & "\" & D) And vbDirectory And D <> "."  And D <> ".." Then
  'далее по тексту

Dir(path, vbDirectory Or vbNormal)

Dir(path, vbDirectory)

'Объявляем переменные
Dim FSO, SFold, SubFolders, sFlds, tsOut 
 
'Создаем объект FileSystemObject
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
'Создаем файл, куда будем записывать имена подкаталогов
Set tsOut = FSO.CreateTextFile("output.txt", True, False) 
'Путь к корневому каталогу
SFold = "C:\Program Files\"
Set Folder = FSO.GetFolder(SFold)
'Цикл по всем подкаталогам
for Each SubFolder In Folder.SubFolders
         sFlds = SFold & SubFolder.Name
'Выводим полученные строки в файл output.txt
         tsOut.WriteLine sFlds
Next
         tsOut.Close
WScript.Quit