List matching folders in a directory
March 18, 2009 • JP • No Comments • Rate This Article
• Links to this article
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.
' 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
' 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.
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.)
' 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
(No Ratings Yet)
Loading ...What now?
Subscribe To The Blog
Email This Article
Follow Me On Twitter
My Facebook Page
Or just keep reading:
I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space if you want to learn more about VBA. Keep Reading »
Previous Post: Bingo Number Selector, Part Deux
Next Post: Bingo Excel Video Tutorial
Good article!
On the issue of dumping the array to a range, it doesn't work as is, because the array only has one dimension. The cleanest way to fix the problem is probably this:
rng.Value = Application.Transpose(vFound)
The Transpose function automatically converts vFound to a two-dimensional array in one step.
Stan
Good call Stan! That worked. I knew it was something simple, but the solution eluded me. I'll update the code right away.
Nice site Jimmy. I plan to steal liberally… errr… study your work extensively for use in my own excel spreadsheets.
Thanks again for dropping in to lend a hand at botw. Saw this on your profile and knew I had to add it to my feed subscriptions.
~ robjones
No problem Rob. Feel free to
stealborrow whatever you need.