Public Sub ListDirsAndSubdirs()
startdir = "c:\"' replace with starting directory On Error GoTo NEXT_STEP
' find all directories and subdirs from a starting point current = 0
dircount = 0
currentdir = startdir
While current <= dircount
subdirect = Dir(currentdir, vbDirectory + vbHidden)
While subdirect <> ""
If subdirect <> "." And subdirect <> ".." Then
If (GetAttr(currentdir & subdirect) And vbDirectory) = vbDirectory Then
dircount = dircount + 1
ReDim Preserve aryFoundDirectories(dircount)
aryFoundDirectories(dircount) = currentdir & subdirect & "\"
End If
End If
subdirect = Dir
Wend
current = current + 1
currentdir = aryFoundDirectories(current)
Wend
dircount = dircount + 1
ReDim Preserve aryFoundDirectories(dircount)
aryFoundDirectories(dircount) = startdir
NEXT_STEP:
' find all files with matching extensions For i = 1 To UBound(aryFoundDirectories())
Selection.InsertAfter Text:=aryFoundDirectories(i) & Chr(13)
Selection.START = Selection.End
Next
End Sub