Boucler sur les sous dossiers de noms variables dans un répertoire

Bonjour forum,

J'ai trouvé après une longue recherche une procédure qui permet de vérifier si un sous dossier n'est pas vide. Ce sous dossier in connait pas de bas son nom complet, une partie de son nom existe dans une colonne .

Cependant, je voudrai généraliser ça sur l'ensemble de mes sous dossiers mais la boucle ne marche pas :(

Voici le code:

Sub test()
    Dim Chemin As String, NomRep As String, debut  As String, dl As Long, dos As String, pasvidedos As String, pasvidefic As String
    dl = Sheets("GE S").Cells(Rows.Count, 1).End(xlUp).Row
    Chemin = "C:\FGG\Contrats Cd\"
    NomRep = Dir(Chemin, vbDirectory)    ' Premier dossier.
   For i = 2 To 3
   debut = Sheets("GE S").Range("A" & i)
Do While NomRep <> ""
        If NomRep <> "." And NomRep <> ".." Then
            If (GetAttr(Chemin & NomRep) And vbDirectory) = vbDirectory Then
                If Not (IsError(Application.Search(debut, NomRep))) Then
                dos = Chemin & NomRep & "\Securite\Amiante\"
                pasvidedos = Dir(dos, vbDirectory Or vbHidden)
 Do While pasvidedos <> ""
    If pasvidedos <> "." And pasvidedos <> ".." Then Exit Do
    pasvidedos = Dir
 Loop
 pasvidefic = Dir(dos, vbNormal Or vbHidden)
 If pasvidedos & pasvidefic = "" Then
   Sheets("GE S").Range("E" & i) = "Not Ok"
 Else
   Sheets("GE S").Range("E" & i) = "Ok"
 End If

  Dim objLink As Hyperlink
  Sheets("GE S").Select
 Set objLink = ActiveSheet.Hyperlinks.Add(Range("D" & i), dos)
                Exit Do
                End If
            End If
        End If
        NomRep = Dir        ' Extrait l'entrée suivante.
   Loop
   Next
End Sub

Qqn a une idée ?

Merci d'avance :)