Sub RechercheFichier()
Chemin = "C:\Chemin\"
FindNom = "NomFichier" ' nom complet ou partie
Extension = "xls" ' ou *
DirFileName = FindRecherche & "." & Extension
Dim FSO As FileSystemObject, SourceFolder As Folder, SubFolder As Folder, FileItem As File
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(Chemin)
DernLig = ActiveSheet.Columns(NoDeCol).Rows(Rows.Count).End(xlUp).Row
Fichier = Dir(Chemin & DirFileName)
Do While Fichier > ""
If InStr(LCase(Fichier), LCase(FindRecherche)) Then
Set FileItem = FSO.GetFile(Chemin & Fichier)
I = InStrRev(Fichier, "."): If I Then Fichier = Left(Fichier, I - 1)
Cells(DernLig, NoDeColFich) = Fichier
Cells(DernLig, NoDeColDate) = FileItem.DateLastModified
ActiveSheet.Hyperlinks.Add Cells(DernLig, NoDeColLien), FileItem.Path
TotFichTrouve = TotFichTrouve + 1: DernLig = DernLig + 1
End If
Fichier = Dir
Loop
Set FSO = Nothing: Set SourceFolder = Nothing: Set SubFolder = Nothing: Set FileItem = Nothing
End Sub