List matching folders in a directory

The following function will return a comma delimited list of folders one level below the specified folder. For example, if you needed to fill a listbox or worksheet with a list of matching folder names. The code assumes that you do not use commas in your folder names.

Function GetFolders(strMatch As String, strPath As String) As String
' gets matching folder list from a given path and
' concatenates it into a string for later processing

' strPath = the path you want to search
' strMatch = the string you want to match in the folder name

' ex: strPath = "C:\"
' strMatch = "Doc"
' will return a comma delimited list of all folders one level below C:
' which contain the string "Doc"

Dim fso As Object ' Scripting.FileSystemObject
Dim mainfldr As Object ' Scripting.Folder

Set fso = GetFSO
Set mainfldr = fso.GetFolder(strPath)

Dim subfldr As Object ' Scripting.Folder

For Each subfldr In mainfldr.SubFolders
  If InStr(subfldr.Name, strMatch) > 0 Then
    If Len(GetFolders) = 0 Then
      GetFolders = subfldr.Path
    Else
      GetFolders = GetFolders & "," & subfldr.Path
    End If
  End If
Next subfldr

End Function

Function GetFSO() As Object
' returns a reference to the Scripting.FileSystemObject to the calling sub
On Error Resume Next
  Set GetFSO = GetObject(, "Scripting.FileSystemObject")
On Error GoTo 0

If GetFSO Is Nothing Then
  Set GetFSO = CreateObject("Scripting.FileSystemObject")
End If
End Function

Usage:

The following code will return a comma delimited list of folders in the C:\ folder that contain the string "Doc" in the folder name. The string is then split into a zero-index array, with each folder as a member of the array.

Sub test()
Dim str As String

str = GetFolders("Doc", "C:\")

Dim vArrText As Variant
vArrText = Split(str, ",")

End Sub

Here's a more detailed example to show how you might use this function.

I set up a sample workbook with the function above. It searches the specified folder for the folders with matching string. A button on the worksheet runs the macro that returns values to column A.

Here is the button code. I am having one problem, though; Dumping the array to a range doesn't seem to be working. In other words, rng.Value = vFound doesn't work. Any ideas? (See Stan's comment below for solution. Code below was updated 3/18/09 at 9:30 PM.)

Private Sub btnSearch_Click()

' get values from worksheet
Dim folderToSearch As String
Dim stringMatch As String
folderToSearch = Range("FolderToSearch").Value
stringMatch = Range("StringMatch").Value

' get matching folder list
Dim foundFolders As String
Dim vFound As Variant
foundFolders = modRun.GetFolders(stringMatch, folderToSearch)

vFound = Split(foundFolders, ",")

' count how many cells are needed
Dim folderCount As Long
folderCount = UBound(vFound) + 1

' set up range and write values to it
If folderCount > 0 Then

  ' this range won't exist the first time
  On Error Resume Next
  Range("Folders").ClearContents
  On Error GoTo 0

  Dim rng As Excel.Range
  Set rng = Range(Range("A1"), Range("A1").Offset(folderCount - 1, 0))

  rng.Name = "Folders"

  rng.Value = Application.Transpose(vFound)

End If

ExitProc:
Application.ScreenUpdating = True
Set rng = Nothing
End Sub

Download sample workbook

Related Articles:

• November 17, 2008 -- Take advantage of Intellisense when writing late bound code