Sub Test()
maliste = liste_mes_Fichiers("C:\Résultats\") ' EXTENTION DEMANDE
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
For l = LBound(maliste) To UBound(maliste)
If maliste(l) Like "*" & Cells(i, "A").Text & ".*" Then Cells(i, "B").Value = maliste(l)
Next
Next
End Sub
Function liste_mes_Fichiers(path As String, Optional T As Variant = Null, Optional ExT As Variant = 0, Optional a As Long = 0)
Dim itemVU As String, folder As Variant, dirCollection As Collection, i As Long
Set dirCollection = New Collection
If IsNull(T) Then T = Array()
crit = vbDirectory Or vbHidden Or vbNormal Or vbArchive Or vbReadOnly Or vbSystem Or vbVolume
On Error GoTo passe
itemVU = Dir(path, crit)
Do Until itemVU = vbNullString
If Left(itemVU, 1) <> "." And Not path Like "*RECYCLE*" Then
If (GetAttr(path & itemVU) And vbDirectory) <> vbDirectory Then
If IsArray(ExT) Then
For i = 0 To UBound(ExT)
If itemVU Like "*" & ExT(i) Then
ReDim Preserve T(0 To a): T(a) = path & itemVU: a = a + 1:
End If
Next
Else
ReDim Preserve T(0 To a): T(a) = path & itemVU: a = a + 1:
End If
End If
End If
'ajout des dossiers enfant direct de la racine a la collection
If Left(itemVU, 1) <> "." And (GetAttr(path & itemVU) And vbDirectory) = vbDirectory Then
dirCollection.Add itemVU
End If
itemVU = Dir()
Loop
passe:
Err.Clear
'Exploration des subdossier inscrit dans la collection
For Each folder In dirCollection
liste_mes_Fichiers path & folder & "\", T, ExT, a
Next folder
liste_mes_Fichiers = T
End Function