Option Explicit

Sub ListaCarpetas(CarpetaOrigen, Buscamos)
Dim fso As Object
Dim carpeta As Object
Dim Subcarpeta As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set carpeta = fso.GetFolder(CarpetaOrigen)
    
    For Each Subcarpeta In carpeta.SubFolders
     If InStr(1, Subcarpeta.Name, Buscamos) Then
      'aqui encontramos algo...lo muestro en un MsGbox
      'lo puedes meter en un cuadro de lista, en una tabla, en un array...donde quieras
      MsgBox Subcarpeta.Name
     End If
        
    Next
    
    Set carpeta = Nothing
    Set fso = Nothing
    
End Sub

Sub prueba()
' Javier.....prueba esta funcion
'Como primer parametro metemos la ruta desde donde buscar. Aqui en el ejemplo
'he puesto todo el disco duro C
'Como segundo parametro paso las subcarpetas a buscar
'En esta caso, todas aquellas que contengan la palabra WIN en su nombre
'Luego con la funcion de mas arriba utilizo la funcion Instr, lo que implica
'que me encontrará todas las carpetas que contengan, al principio, en medio
'o al final la palabra WIN
'Puedes utilizar otras funciones de comparación como MID etc, para que te busque
'desde la posición del nombre de carpeta que tu desees.

  Call ListaCarpetas("C:\", "Win")
End Sub