Renvoi des propriétés de fichier

Pour obtenir la date de la dernière modification d'un fichier actif, utiliser :
ActiveWorkbook.BuiltinDocumentProperties("Last save time").Value

Patrice

bonjour,

Voici une proposition sans ouvrir les classeurs

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

Michel

Bonjour,

En creusant un peu voila ce que j'ai fait, mais il y a un problème
Rappel :
3 fichiers sont concernés, la boite de dialogue doit récapituler les propriétés des 3 fichiers en une seule.

'Sub Date_Fichier()
' proprietesFichier_getFileF "\\Mon-file\departement_documentation_technique\Prj_MAINTENANCE\Prj_AMM\2- Gestion_AMM_TSM_SERIE\OGI\Exp_par_Programme\Fexport.xls"
' proprietesFichier_getFileL "\\Mon-file\departement_documentation_technique\Prj_MAINTENANCE\Prj_AMM\2- Gestion_AMM_TSM_SERIE\OGI\Exp_par_Programme\Lexport.xls"
' proprietesFichier_getFileN "\\Mon-file\departement_documentation_technique\Prj_MAINTENANCE\Prj_AMM\2- Gestion_AMM_TSM_SERIE\OGI\Exp_par_Programme\Nexport.xls"
'
'End Sub
'
'
'Sub proprietesFichier_getFile(Fichier As String)
' '
' 'Nécessite d'activer la référence Microsoft Scripting Runtime
' '
' Dim CibleF As Scripting.FileSystemObject
' Dim CibleL As Scripting.FileSystemObject
' Dim CibleN As Scripting.FileSystemObject
'
' Dim ValeurF As Scripting.File
' Dim ValeurL As Scripting.File
' Dim ValeurN As Scripting.File
'
' Dim ResultatF As String
' Dim ResultatL As String
' Dim ResultatN As String
'
' Set CibleF = CreateObject("Scripting.fileSystemObject")
' Set CibleL = CreateObject("Scripting.fileSystemObject")
' Set CibleN = CreateObject("Scripting.fileSystemObject")
'
'
' Set ValeurF = CibleF.GetFile(Fichier)
' Set ValeurL = CibleL.GetFile(Fichier)
' Set ValeurN = CibleN.GetFile(Fichier)
'
' ResultatF = "Nom fichier : " & CibleF.GetFileName(ValeurF) & Chr(10) & Chr(10) & _
' "Derniere modification : " & ValeurF.dateLastModified & Chr(10) & Chr(10)
' ResultatL = "Nom fichier : " & CibleL.GetFileName(ValeurL) & Chr(10) & Chr(10) & _
' "Derniere modification : " & ValeurL.dateLastModified & Chr(10) & Chr(10)
' ResultatN = "Nom fichier : " & CibleN.GetFileName(ValeurN) & Chr(10) & Chr(10) & _
' "Derniere modification : " & ValeurN.dateLastModified & Chr(10) & Chr(10)
'
' MsgBox (ResultatF & ResultatL & ResultatN; vbOk; Date Fichiers Sources)
' 'MsgBox (ResultatF + ResultatL + ResultatN)
'
'End Sub

Pourriez vous me dire ce qui cloche .....

Merci par avance

Un développeur débutant