Option Explicit
Sub Test()
MsgBox RéfFic("C:\Users\Luck", "Pic*", "DéS*.Png")
End Sub
Function RéfFic(ByVal Racine As String, ParamArray PAMasques() As Variant) As String
Dim FSO As New FileSystemObject, Dossier As Folder, Fichier As File, TMsq() As String, M&
ReDim TMsq(1 To UBound(PAMasques) + 1)
For M = 1 To UBound(TMsq): TMsq(M) = UCase$(PAMasques(UBound(TMsq) - M)): Next M
On Error Resume Next
Set Dossier = FSO.GetFolder(Racine)
If Err Then RéfFic = "(" & Racine & " ?)": Exit Function
Set Fichier = FicChrch(Dossier, TMsq)
If Fichier Is Nothing Then RéfFic = "(" & Racine & ", " & Join(PAMasques, ", ") & " ?)": Exit Function
RéfFic = Fichier.Path
End Function
Private Function FicChrch(ByVal Doss As Folder, TMasques() As String) As File
Dim TMasquesRestants() As String, UBTM&, Masque As String
On Error Resume Next
UBTM = UBound(TMasques): Masque = TMasques(UBTM)
If UBTM > 1 Then
TMasquesRestants = TMasques: ReDim Preserve TMasquesRestants(1 To UBTM - 1)
For Each Doss In Doss.SubFolders
If UCase$(Doss.Name) Like Masque Then Set FicChrch = FicChrch(Doss, _
TMasquesRestants): If Not FicChrch Is Nothing Then Exit Function
Next Doss
Else
For Each FicChrch In Doss.Files
If UCase$(FicChrch.Name) Like Masque Then Exit Function
Next FicChrch: End If
End Function