Créer une liste a partir de l'Explorateur ?

Sub AfficheInfoAccesFichier()
Dim specfichier As String
specfichier = ActiveWorkbook.Name
    Dim fs, D, F, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFile(specfichier)
    s = UCase(F.Path) & vbCrLf
    s = s & "Créé le : " & F.DateCreated & vbCrLf
    s = s & "Dernier accès le : " & F.DateLastAccessed & vbCrLf
    s = s & "Dernière modification le : " & F.DateLastModified
    MsgBox s, 0, "Infos d'accès au fichier"
End Sub

Sub Recupfile()
Dim fs, F, f1, s, sf
Dim Ext As String, Chemin As String
Dim i As Long, Fin As Long
    Ext = "xls"
    Chemin = "C:\"
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    For Each f1 In sf
        If Right(f1.Name, 3) = Ext Then
            'Adapté les adresses cellules.
            Cells(3, i) = f1.Name
        End If
        i = i + 1
    Next
End Sub

Option Explicit
Dim Lig As Long
Function SelectionRepertoir()
Dim nomfich As String, i As Integer
    nomfich = Application.GetOpenFilename(FileFilter:="Tout Fichier (*.*),*.*" _
            , Title:="Sélectionnez le répertoir")
    For i = Len(nomfich) To 1 Step -1
        If Mid(nomfich, i, 1) = "\" Then Exit For
    Next i
    SelectionRepertoir = Left(nomfich, i)
End Function


Sub Recupfile()
Dim fs, F, f1, s, sf
Dim Ext As String, Chemin As String
Dim i As Long, Fin As Long
   ' Mettre le curseur ICI
   'et taper F5
    Chemin = SelectionRepertoir()
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    For Each f1 In sf
        AfficheInfoAccesFichier (f1)
        'If Right(f1.Name, 3) = Ext Then
        '    'Adapté les adresses cellules.
        '    Cells(3, i) = f1.Name
        'End If
        i = i + 1
    Next
End Sub
Sub AfficheInfoAccesFichier(specfichier)
'Dim specfichier As String
'specfichier = ActiveWorkbook.Name
    Sheets("feuil1").Select
    Lig = Range("A65536").End(xlUp).Row + 1
    Dim fs, D, F, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFile(specfichier)
    Cells(Lig, 1) = "Fichier " & F
    Cells(Lig, 2) = UCase(F.Path)
    Cells(Lig, 3) = "Créé le : " & F.DateCreated
    Cells(Lig, 4) = "Dernier accès le : " & F.DateLastAccessed
    Cells(Lig, 5) = "Dernière modification le : " & F.DateLastModified
    'MsgBox s, 0, "Infos d'accès au fichier"
End Sub