GenArrayDir

Dim File As String, Found As Boolean
Dim FoundEntry As Boolean, i As Integer
Dim Dirs() As String, n As Integer

ReDim Dirs(1 To 1): ReDim SubDirs(1 To 1)
If Not Right$(Directory, 1) = "\" Then Directory = Directory & "\"
Dirs(1) = Directory

FindDirs:

Found = False
For i = 1 To UBound(Dirs)
If Dirs(i) "" Then
File = Dir$(Dirs(i), vbDirectory)
Do Until File = ""
If (Left$(File, 1) ".") And ((GetAttr(Dirs(i) & File) And vbDirectory) > 0) Then
Found = True
FoundEntry = False
For n = 1 To UBound(Dirs())
If Dirs(n) = "" Then
FoundEntry = True
Dirs(n) = Dirs(n) & File & "\"
End If
Next n
If Not FoundEntry Then
ReDim Preserve Dirs(1 To UBound(Dirs) + 1)
Dirs(UBound(Dirs)) = Dirs(i) & File & "\"
End If
End If
File = Dir$()
Loop
If SubDirs(1) = "" Then
SubDirs(1) = Dirs(i)
Else
ReDim Preserve SubDirs(1 To UBound(SubDirs) + 1)
SubDirs(UBound(SubDirs)) = Dirs(i)
End If
Dirs(i) = ""
End If
Next i
If Found Then GoTo FindDirs
Erase Dirs()
GetSubDirs = UBound(SubDirs)

End Function