Code
Public Function AsStringArray_SubFolders(ByVal FolderSpec As String) As String()
'Purpose
'   Used to get a list of folders in a specified folder.
'Return (String())
'   Returns a list of all folders that exist in the specified folder.
'Version History
'   1.0 12/15/2005 Tested by Russ Tanner
'---

'Initiate variables
Dim X As String 'general buffer to store the current folder or file name in the loop
Dim C As Long 'tracks the total number of elements in the return buffer
Dim R() As String 'return buffer

'Make sure FolderSpec ends with a backslash
If Right(FolderSpec, 1) <> "\" Then FolderSpec = FolderSpec & "\"

'Loop through all folders in the "DB" folder
X = Dir(FolderSpec, vbDirectory) 'get the first folder
Do While X <> ""
    'Ignore the current and parent folders
    If X <> "." And X <> ".." Then
        'Test to make sure it's a folder
        If (GetAttr(FolderSpec & "\" & X) And vbDirectory) = vbDirectory Then
            'Add the folder to the return buffer
            ReDim Preserve R(C)
            R(C) = X
            'Increment the return buffer element pointer
            C = C + 1
        End If
    End If
    X = Dir
Loop

'Return the result
AsStringArray_SubFolders = R

End Function


The Captian
Today they call you "crazy". Tomorrow they call you "ahead of your time."
Global Skywatch Learn about Chemtrails - You're breathing them now!
OnlyTheBestHerbs.com World-class supplements
Mercury Talk Why you are sick.
OneUp Domains Domains, Hosting, Email
1-800-358-4278 (U.S. & Canada)