Renvoi des propriétés de fichier

Option Explicit 

Sub Lister_Fichiers_DateDreation() 
     'source à partir de l'auteur Silkyroad sur 
     'http://excel.developpez.com/faq/?page=FichiersDir#TriFichiersRep 
    Dim Fichier As String, Chemin As String 
    Dim Fso As Object 
    Dim FileItem As Object 
    Dim Tableau() 
    Dim cptr As Integer 
             
    Chemin = recherchedossier 
    Fichier = Dir(Chemin & "\*.xls") 
    'Boucle sur les fichiers 
    Do 
        cptr = cptr + 1 
        ReDim Preserve Tableau(1 To 2, 1 To cptr) 
        Tableau(1, cptr) = Fichier 
                        
        Set Fso = CreateObject("Scripting.FileSystemObject") 
        Set FileItem = Fso.GetFile(Chemin & "\" & Fichier) 
         
        'récupére la date de dernière modification 
        Tableau(2, cptr) = Left(FileItem.DateLastModified, 10) 
         
        Fichier = Dir 
    Loop Until Fichier = "" 
          
    '--- Transfère les données dans la feuille de calcul --- 
   With Sheets("Feuil2") 
          .Range("A1").Resize(cptr, 2) = Application.Transpose(Tableau) 
    End With 
End Sub 

'------------------------------------------------------- 
Function recherchedossier() 
'Auteurs: @+thierry_xld et michel_m 
Dim ObjShell As Object, ObjFolder As Object 
Dim Message As String 
Dim Chemin As String 
     
Message = "Faire la Sélection du Repertoire de travail:" 

Set ObjShell = CreateObject("Shell.Application") 
Set ObjFolder = ObjShell.BrowseForFolder(&H0&, Message, 1) 
     
    On Error Resume Next 'Si on sort sans sélection 
    Chemin = ObjFolder.ParentFolder.ParseName(ObjFolder.Title).Path & "" 
    If Chemin = "" Then End 
    recherchedossier = Chemin 
End Function