List folders in directory, with criteria

[Formula11]

Apologies if this is a considered a duplicate post.

This macro lists first and second level sub-folders after the selected folder "folderspec", with the condition that any of the subfolders' name contains the string "OK" (sub-folder with this string can be at any level).
The output is divided into separate columns starting at column J.

The macro has the following inconsistency:
- It only works if the subfolder which contains the string "OK" is the first one in the set.
LISTED: {Subfolder 3-A OK, Subfolder 3-B}
NOT LISTED: {ASubfolder, Subfolder 3-A OK, Subfolder 3-B}

Notes on code:
- Microsoft Scripting Runtime required as reference (Tools/References)
- Specify directory in variable "folderspec"
- Specify word/string in Function (in this case "OK")
- Output starts at cell J1

'References: Microsoft Scripting Runtime

Dim Exists As Boolean

Sub Regather()
    Dim fs, fc, fcsub
    Dim f As Scripting.Folder, f1 As Scripting.Folder
    Dim n As String
    Dim r As Integer, C As Integer
    Dim folderspec As String
    Dim OriginalLocation As Range
    Application.ScreenUpdating = False
    Set OriginalLocation = Selection
    Range(Range("J1"), Cells(Rows.Count, Columns.Count)).ClearContents
    folderspec = "C:\" '********** Directory
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Set fc = f.subfolders
    n = f.Name
    r = 1
    C = 1
    ' Loop through folders
    For Each f1 In fc
        Exists = False
        Call LookForFolder(f1, True)
        If Exists = True Then
            Cells(r + 1, C + 9) = f1.Name
            Set fcsub = f1.subfolders
            r = r + 1
                For Each f2 In fcsub
                    Cells(r + 2, C + 9) = f2.Name
                    r = r + 1
                Next
            C = C + 1
            r = 1
         End If
    Next
End Sub

Function LookForFolder(objFolder As Scripting.Folder, IncludeSubfolders As Boolean)
    Dim objSubFolder As Scripting.Folder
    If InStr(objFolder.Path, "OK") <> 0 Then '********** Word looking for
        Exists = True
    End If
    If IncludeSubfolders Then
        For Each objSubFolder In objFolder.subfolders
            Call LookForFolder(objSubFolder, True)
            Exit Function
        Next objSubFolder
    End If
End Function

 

[pbornemeier]

You will need to extract ALL filenames in your directory structure to the desired level to an array (or worksheet) then examine the array for the matching word.
As you go to the next layer of subfolders, increment a depth counter to limit how far down you look.
Code in this post: https://www.mrexcel.com/forum/excel-questions/480404-vba-list-folder-names-size.html
Produces a list of all folders below a selected starting folder

 

[Formula11]

Hi. I don't quite have the knowledge to modify the code you referred to.
Is there a way to include a counter into the code in OP?

 

[Fennek]

Hi

just another idea:

Use CMD.Exe with

dir /s/ad > myList.txt

to get all names of subdirectories, import the txt-file into xl and filter.

regards