ワイルドカード検索機能をループする方法

Question

ワイルドカードを使用して特定のディレクトリを検索し、一致するフォルダを出力するスクリプトを作成しました。私が実行している問題は、ワイルドカードが一致する複数のフォルダがあります。スクリプトは一致する最初のフォルダのみを返します。

私はディレクトリ（私の場合はD：\ P）のコードループを持ち、一致するすべてのフォルダを出力できますか？

ご協力いただければ幸いです。ありがとう！ここで

は私のコードです：

Dim sFile As String, sPathSeek As String, sPathMatch As String 

    Dim sMainPath As String 
    sMainPath = sfolderPath 'D:\P\ 

    Dim Path1 As String 'THIS IS THE FIRST STRING I NEED A WILDCARD TO FIND 
    Path1 = "_Links" 
    Dim Path2 As String 'THIS IS THE SECOND STRING I NEED A WILDCARD TO FIND 
    Path2 = "TLP" 


'FIND THE FOLDER THAT CONTAINS THE FIRST PATH USING A WILDCARD 
    On Error Resume Next 
    sPathSeek = sMainPath & "*" & Path1 
    sFile = Dir(sPathSeek, vbDirectory) 


    Do While Len(sFile) > 0 
     If Left(sFile, 1) <> "." Then 
      If (GetAttr(sFile) And vbDirectory) = vbDirectory Then 
       sPathMatch = sFile 
       Exit Do 
      End If 
     End If 
     sFile = Dir 
    Loop 


    MsgBox IIf(sPathMatch = "", "Match not found", "Match: " & sPathMatch) 

Answer 1

Dim Sep as string 
'.... 
Sep = "" 
Do While Len(sFile) > 0 
    If Left(sFile, 1) <> "." Then 
     If (GetAttr(sFile) And vbDirectory) = vbDirectory Then 
      sPathMatch = sPathMatch & Sep & sFile 
      Sep = ", " 
     End If 
    End If 
    sFile = Dir 
Loop 


MsgBox IIf(sPathMatch = "", "Match not found", "Match: " & sPathMatch) 

編集：ここでは "_Links" の直下に存在するすべての "TLP" フォルダを収集する方法の一例だ

Sub TestFolderMatches() 

    Dim col As Collection, f 

    Set col = GetFolderMatches("C:\_Stuff\test") 
    For Each f In col 
     Debug.Print f 
    Next f 

End Sub 



'Return a collection of folders matching "*\_Links\TLP" given a starting folder 
Function GetFolderMatches(startFolder As String) As Collection 

    Dim fso, fldr, f, subFldr 
    Dim colFolders As New Collection 
    Dim colSub As New Collection 

    Set fso = CreateObject("scripting.filesystemobject") 
    colSub.Add startFolder 

    Do While colSub.Count > 0 

     Set fldr = fso.getfolder(colSub(1)) 
     colSub.Remove 1 

     For Each subFldr In fldr.subFolders 
      'collect any folder named "TLP" inside a "_Links" folder 
      If subFldr.Name = "TLP" And fldr.Name = "_Links" Then 
       colFolders.Add subFldr.Path '<< collect this one 
      Else 
       colSub.Add subFldr.Path '<< search this one 
      End If 

     Next subFldr 
    Loop 

    Set GetFolderMatches = colFolders '<< return the collected folders 

End Function