A Cool Directory Map

Private Sub CommandButton1_Click()
 Call DirMap("C:\Windows\")
 'Must have "\" at the end of the path
End Sub
Sub DirMap(ByVal Path As String)
On Error Resume Next
 Dim i, j, x As Integer 'All used as counters
 Dim Fname(), CurrentFolder, Temp As String
 Temp = Path
 If Dir(Temp, vbDirectory) = "" Then Exit Sub 'if there arent any sub directories the exit
 CurrentFolder = Dir(Temp, vbDirectory)
 'First get number of folders (Stored in i)
 Do While CurrentFolder <> ""
 If GetAttr(Temp & CurrentFolder) = vbDirectory Then
  If CurrentFolder <> "." And CurrentFolder <> ".." Then
  i = i + 1
  End If
 End If
 CurrentFolder = Dir
 Loop
 ReDim Fname(i) 'Redim the array with number of folders
 'now store the folder names
 CurrentFolder = Dir(Temp, vbDirectory)
 Do While CurrentFolder <> ""
 If GetAttr(Temp & CurrentFolder) = vbDirectory Then
  If CurrentFolder <> "." And CurrentFolder <> ".." Then
  j = j + 1
  Fname(j) = CurrentFolder
  Debug.Print Temp & Fname(j)
  End If
 End If
 CurrentFolder = Dir
 Loop
 ' For each folder check to see there are sub folders
 For x = 1 To i
 Call DirMap(Temp & Fname(x) & "\")
 Next
End Sub