SALUT
Cela devrai te dépanner ,c'est une fonction récursive
Sub RecurseTree(DossierDepart As String, Chaine As String)
'-Attention le chemin du dossier de depart doit comporter un slash à la fin
On Error Resume Next
'-Déclarations dossiers
Dim intN As Long
Dim intDirectory As Long
Dim strFileName As String
Dim strDirectoryList() As String
'-Déclarations fichiers
Dim PosPoint As String
'-Départ de la recherche
strFileName = LCase(Dir(DossierDepart, vbDirectory))
Do While strFileName <> ""
'-Ignorer le répertoire en cour, le répertoire parent, et
If strFileName <> "." And strFileName <> ".." Then
'-Lire tous les fichiers et les dossiers
If GetAttr(DossierDepart & strFileName) Then
'-Lire si le nom du fichier contient la chaine rechercher
'-Test si cela est bien un fichier
'-Chercher la présence du point de l'extension du fichier
If InStr(strFileName, ".") <> 0 Then
'-Rechercher la chaine et la rajouter à la liste
If InStr(1, strFileName, Chaine, 1) Then List1.AddItem (DossierDepart & strFileName)
End If
intDirectory = intDirectory + 1
ReDim Preserve strDirectoryList(intDirectory)
strDirectoryList(intDirectory) = DossierDepart _
& strFileName
End If
End If
'-Nouveau depart pour la recherche
strFileName = Dir
Loop
'-Traiter récursivement tous les répertoires
For intN = 1 To intDirectory
RecurseTree strDirectoryList(intN) & "\", Chaine
Next intN
End Sub
A++ BFR
|