Option Explicit
Public Chemin As String, I As Long
Sub RepFichiers()
Dim objShell As Object, objFolder As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
On Error GoTo 0
If Chemin = "" Then Exit Sub
Application.ScreenUpdating = False
With Sheets("ACCUEIL")
.Range("B12") = Chemin
.Range("B16:E10000").ClearContents
End With
I = 16
ListeFichier (Chemin)
End Sub
Function ListeFichier(Chemin As String) As String
Dim Dossier As Object, SousDossier As Object, Fichier As Object
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
With Sheets("ACCUEIL")
For Each SousDossier In Dossier.SubFolders
    .Cells(I, 2) = SousDossier.Name
    For Each Fichier In SousDossier.Files
    .Cells(I, 3) = Left(Fichier.Name, InStr(Fichier.Name, ".") - 1) 'Nom du fichier avec l'extension
    .Cells(I, 4) = Dossier & "\" & SousDossier & "\" & Fichier.Name
 
    .Cells(I, 5) = Fichier.DateCreated  ' Date de création
    .Cells(I, 6) = Fichier.DateLastModified  ' dernière modification
ActiveSheet.Hyperlinks.Add Anchor:=Cells(I, 4), Address:=SousDossier & "\" & Fichier.Name
    I = I + 1
     Next
Next
End With
End Function