Verifier si dossier contient chaine de caractères

Regarde ce que te donne l'aide F1 sur dir:

Dir, fonction, exemple
Cet exemple utilise la fonction Dir pour vérifier si certains fichiers et dossiers existent. Sur le Macintosh, "HD:" désigne le lecteur par défaut et les éléments du chemin d'accès sont séparés par deux points (:) et non par des barres obliques inversées. Les caractères de remplacement de Microsoft Windows sont considérés par le Mac comme des caractères significatifs faisant partie du nom du fichier. Vous pouvez cependant utiliser la fonction MacID pour désigner des groupes de fichiers.

Dim MyFile, MyPath, MyName
' Renvoie "WIN.INI" (sur Microsoft Windows) si ce fichier existe.
MyFile = Dir("C:\WINDOWS\WIN.INI")

' Renvoie le nom de fichier avec l'extension indiquée. Si plusieurs
' fichiers *.ini existent, le premier fichier trouvé est renvoyé.
MyFile = Dir("C:\WINDOWS\*.INI")

' Appelle de nouveau Dir sans argument pour renvoyer le
' fichier *.INI suivant dans le même dossier.
MyFile = Dir

' Renvoie le premier fichier *.TXT avec l'attribut fichier caché.
MyFile = Dir("*.TXT", vbHidden)

' Affiche les noms dans C:\ représentant des dossiers.
MyPath = "c:\" ' Définit le chemin d'accès.
MyName = Dir(MyPath, vbDirectory) ' Extrait la première entrée.
Do While MyName <> "" ' Commence la boucle.
' Ignore le dossier courant et le dossier
' contenant le dossier courant.
If MyName <> "." And MyName <> ".." Then
' Utilise une comparaison au niveau du bit pour
' vérifier que MyName est un dossier.
If (GetAttr(MyPath & MyName) _
And vbDirectory) = vbDirectory Then
Debug.Print MyName ' Affiche l'entrée uniquement si elle
End If ' représente un dossier.
End If
MyName = Dir ' Extrait l'entrée suivante.
Loop

Tu peux donc faire une boucle sur un répertoire pour voir si ce dossier existe

bonjour a tous et tout plein de bonne chose pour cette nouvelle année

c_pivert ton code fonctionne parfaitement

l’idée maintenant est de rechercher une chaine de caractère du type 19120202 qui ce trouve en B23,
si la macro trouve 19120202 elle ajoute 1 à B23 soit 19120203 et ainsi de suite jusqu'à le numéro ne soit pas attribué
le problème c’est que suis obligé de relancer la macro entre chaque recherche
(c’est la première fois que je fais une boucle)

Merci de vos lumières
Mon code

Sub RECHERCHE()
Dim rngTrouve As Range
Dim strChaine As String, firstAddress As String
Dim n As Long
    n = 1

strChaine = "*" & Sheets("renseignement client").Range("B23").Value & "*"
    Set rngTrouve = Sheets("Feuil1").Columns(3).Cells.Find(strChaine, , xlValues, xlWhole)
  If Not rngTrouve Is Nothing Then
         firstAddress = rngTrouve.Address
       Do
            MsgBox "Trouvé dans la cellule " & rngTrouve.Address(0, 0) & " !"

Sheets("renseignement client").Range("D23").Value = Sheets("renseignement client").Range("D23").Value + 1
        
        Loop While rngTrouve Is Nothing And rngTrouve.Address <> firstAddress

Else
        MsgBox "Pas trouvé"
    End If
End Sub

@yanndebretagnVois si cela te convient en l'adaptant:

Option Explicit
'https://www.excel-downloads.com/threads/vba-liste-dossiers-et-sous-dossiers-dun-dosssier.126930/
Dim ligne, f, d, racine, fs, dossier_racine, recherche
Dim existe As Boolean
Sub arborescenceRepertoire()
recherche = InputBox("Saisissez le nom du dossier : ", "Recherche dossier", "19123001")
  racine = "C:\Users\moi\Documents\entreprise\devis\"   ' adapter répertoire
  If racine = "" Then Exit Sub
  Range("A:E").ClearContents
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.getfolder(racine)
  ligne = 1
  Lit_dossier dossier_racine, 1
     If existe = False Then MsgBox "Il n'y a aucun dossier à ce nom!", vbInformation, " Recherche dossier"
If IsNumeric(Range("H1")) Then
Range("H2").Value = Range("H1").Value + 1
End If
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
Cells(ligne, niveau) = dossier.Name
Range("H1").Value = dossier.Name
  If dossier.Name = recherche Then
  MsgBox "Le dossier " & recherche & " existe déjà!", vbInformation, " Recherche dossier"
existe = True
Else
existe = False
End If
Cells(ligne, niveau).Font.ColorIndex = 0
   ligne = ligne + 1
 For Each f In dossier.Files
   Cells(ligne, niveau) = f.Name
   Cells(ligne, niveau).Font.ColorIndex = 3
   ligne = ligne + 1
 Next
   For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1
   Next
End Sub

@+ Le Pivert