CODEWITHSUNDEEP
excelvbadir
Diego
Diego

Reputation: 105

List all subfolders that contain keyword

I found an Excel VBA macro that lists all subfolders of a folder, but what I need is to list only subfolders that have a certain keyword in their name. I don't really know where to start. This is what I have so far:

Sub ShowFolderList2()
    Dim fs, f, f1, fc, s, Keyword As String
    Dim folderspec
    Keyword = "test"
    folderspec = CurDir()
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Set fc = f.SubFolders
    For Each f1 In fc
        s = s & f1.name
        s = s & vbCrLf
    Next
    Debug.Print folderspec
    Debug.Print s
End Sub

I have managed to use Dir to list files of a specific extension where its name contains a keyword using the following script:

'EXTENSION TEST
If Extension = "Excel" Then
File1 = Dir(MainPath & Path1 & "*.xl??")
Debug.Print (File1)

ElseIf Extension = "PDF" Then
File1 = Dir(MainPath & Path1 & "*.PDF")
Debug.Print (File1)

ElseIf Extension = "DIR" Then
File1 = Dir(MainPath & Path1 & KeyWord1 & "*", vbDirectory)

'Find path to File1 based on KeyWord1

While (File1 <> "")
   If InStr(File1, KeyWord1) > 0 Then
       'Print File1 path into A column starting in cell 3
       Sheet3.Cells(j + i, 1).Value = Path1 & File1
       i = i + 1
   End If
File1 = Dir
Wend

but I can't put it together to list subfolders/directories. Any help will be appreciated.

Upvotes: 1

Views: 922

Answers (2)

Bond
Bond

Reputation: 16311

The Folder object from the FileSystemObject library contains a SubFolders collection that you can use to iterate the subfolders of a given folder. Just check the Folder.Name property to determine its name and if your keyword exists.

Const strPath    As String = "c:\"
Const strKeyword As String = "program"
Dim objSubFolder As Object

With CreateObject("Scripting.FileSystemObject")
    For Each objSubFolder In .GetFolder(strPath).SubFolders
        If InStr(1, objSubFolder.Name, strKeyword, vbTextCompare) > 0 Then
            Debug.Print objSubFolder.Path
        End If
    Next
End With

On my (64-bit) machine, this prints:

C:\Program Files
C:\Program Files (x86)
C:\ProgramData

Upvotes: 3

SierraOscar
SierraOscar

Reputation: 17637

Try the following, amending the constant expressions as required - a black CMD box will appear for a short period, this is normal:

Sub SO()

Const parentDrive As String = "C:\" '// Change as required
Const keyword As String = "myWord" '// Change as required
Dim results As Variant, folder As Variant

results = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & parentDrive & _
    "*" & keyword & "*"" /B /S /A:D").StdOut.ReadAll, vbCrLf)

For Each folder In results
    Debug.Print folder
Next

End Sub

This runs a Dir command through cmd.exe and reads the output back, then splits the output on line breaks so that we end up with an array of each folder that was returned.

In the example above, the command DIR C:\*myWord* /B /S /A:D is run through CMD.

  • CMD /C - Shell the CMD.exe (anything following is passed as an argument - the /C switch tells the Shell method to close after the command has been executed).
  • DIR C:\*myWord* - search all directories in C:\ for *myWord* (note the * wildcards).
  • /B Basic switch - show the basic format for results.
  • /S Subfolder switch - Drill down through all subfolders during search.
  • /A:D Attribute switch taking a Directory parameter - Only return results that have the attribute of being a directory (not a file).

Upvotes: 0

Related Questions