Microsoft 365 comment trouver la date du plus vieux fichier ( en pdf) dans un répertoire et l'afficher dans excel

pcrab

XLDnaute Nouveau
Bonjour,

Je cherche la solution pour afficher dans une feuille excel, la date du plus vieux fichier(pdf) dans un répertoire donné.
Afin de pouvoir déterminer, une priorité de travail entre plusieurs répertoires.

Merci d'avance
 
Solution
La fonction précédente permettait d'étudier les dernières dates de modification des fichiers.

Celle-ci étudie les dates de création des fichiers :
VB:
Function MinimumDateFichier(chemin$, extension$)
Dim L As Byte, fso As Object, dat As Date, f As Object, fichier$
L = Len(extension)
Set fso = CreateObject("Scripting.FileSystemObject")
dat = CDate("31/12/9999 23:59:59")
For Each f In fso.GetFolder(chemin).Files
    If Right(f.Name, L) = extension Then _
        If CDate(f.DateCreated) < dat Then dat = CDate(f.DateCreated): fichier = f.Name
Next
MinimumDateFichier = Array(dat, fichier) 'vecteur ligne
End Function

Sub Test()
Dim a
a = MinimumDateFichier(ThisWorkbook.Path, ".pdf")
MsgBox Application.Index(a, 2) & vbLf &...

chris

XLDnaute Barbatruc
Bonjour
Possible via PowerQuery intégré à Excel

Dossier à adapter
VB:
let
    Source = Folder.Files("T:\TEMP"),
    #"Lignes filtrées" = Table.SelectRows(Source, each ([Extension] = ".pdf")),
    #"Lignes triées" = Table.Sort(#"Lignes filtrées",{{"Date modified", Order.Descending}}),
    #"Conserver les premières lignes" = Table.FirstN(#"Lignes triées",1),
    #"Autres colonnes supprimées" = Table.SelectColumns(#"Conserver les premières lignes",{"Name", "Date modified"})
in
    #"Autres colonnes supprimées"

sinon VBA
 

vgendron

XLDnaute Barbatruc
Bonjour

si tu fais une recherche sur le forum, tu devrais trouver des solutions pour lister le contenu d'un répertoire (fichiers et sous repertoire)
pour chaque fichier, il sufffit de récuperer sa date de création
en attendant
en PJ, ce que j'avais fait au boulot en récupérant des éléments ici et la, pour faire l'arborescence d'un répertoire

Edit: Hello @chris je n'avais pas encore raffraichi

Edit 2: à noter qu'à l'époque. je ne connaissais pas les tables structurées (j'ai modifié mon code juste avant de le poster
et j'ignorais l'existence de PQ !!
 

Pièces jointes

  • Arboresence.xlsm
    40 KB · Affichages: 4
Dernière édition:

Dudu2

XLDnaute Barbatruc
Le VBA est plus long que le PQ et cherche aussi dans les sous-répertoires.
Edit: Attention ! La date testée est la date de création, pas la date de modification !
VB:
Option Explicit

'Nécessite d'inclure la Reference "Microsoft Scripting Runtime"

Private oFSO As Object
Private PlusVielleDateCréation As Date
Private PlusVieuxFichierPDF As String

Sub Test()
    PlusVielleDateCréation = DateSerial(3000, 1, 1)
    PlusVieuxFichierPDF = ""
    Call ParcoursRépertoire("F:\Téléchargements")
    MsgBox "<" & PlusVieuxFichierPDF & ">"
End Sub

'------------------------
'Parcours d'un répertoire
'------------------------
Sub ParcoursRépertoire(ByVal NomRépertoire As String)
    Dim oDir As Object
  
    If Right(NomRépertoire, 1) <> "\" Then NomRépertoire = NomRépertoire & "\"
  
    'File System Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
  
    Set oDir = oFSO.GetFolder(NomRépertoire)
    Call ParcoursFichiersEtSousRépertoires(oDir)
    Set oFSO = Nothing
End Sub

'-----------------------------------------
'Parcours des fichiers et sous-répertoires
'-----------------------------------------
Sub ParcoursFichiersEtSousRépertoires(oDir As Object, Optional NoRecycle As Boolean = False)
    Dim oSubDir As Object
    Dim oFile As Object

    'Parcours des fichiers du [sous-]répertoire
    For Each oFile In oDir.Files
        Call TraiteFichier(oDir.Path, oFile.Name, oFile.Path)
    Next oFile
  
    'Parcours des sous-répertoires du [sous-]répertoire
    For Each oSubDir In oDir.SubFolders
        If Not ((NoRecycle And oSubDir.Name = "$RECYCLE.BIN") _
        Or oSubDir.Name = "System Volume Information") Then
            Call ParcoursFichiersEtSousRépertoires(oSubDir)
        End If
    Next oSubDir
    Exit Sub
End Sub

'-----------------------
'Traitement d'un fichier
'-----------------------
Sub TraiteFichier(NomRépertoire As String, NomFichier As String, NomCompletFichier As String)
    Dim FileItem As Scripting.File
    Dim DateCréation As Date
    Dim DateModification As Date
    Dim Taille As Double
  
    If Not UCase(Right(NomFichier, 4)) = ".PDF" Then Exit Sub
  
    Set FileItem = oFSO.GetFile(NomCompletFichier)
 
    'Récupère la date de création
    DateCréation = FileItem.DateCreated
  
    'Pour récupérer la date de dernière modification
    DateModification = FileItem.DateLastModified
  
    'Pour récupérer la taille du fichier
    Taille = Left(FileItem.Size, 10)
  
    If DateCréation < PlusVielleDateCréation Then
        PlusVielleDateCréation = DateCréation
        PlusVieuxFichierPDF = NomFichier
    End If
End Sub
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour à tous,

Une solution avec une fonction VBA à placer dans un module standard :
VB:
Function MinimumDateFichier(chemin$, extension$)
Dim fichier$, L As Byte, dat As Date, f$
If Right(chemin, 1) <> Application.PathSeparator Then chemin = chemin & Application.PathSeparator
fichier = Dir(chemin) '1er fichier du dossier
L = Len(extension)
dat = CDate("31/12/9999")
While fichier <> ""
    If Right(fichier, L) = extension Then _
        If CDate(FileDateTime(chemin & fichier)) < dat Then dat = CDate(FileDateTime(chemin & fichier)): f = fichier
    fichier = Dir 'fichier suivant
Wend
MinimumDateFichier = Array(dat, f) 'vecteur ligne
End Function

Sub Test()
MsgBox Application.Index(MinimumDateFichier(ThisWorkbook.Path, ".pdf"), 2) & vbLf & Application.Index(MinimumDateFichier(ThisWorkbook.Path, ".pdf"), 1)
End Sub
Pour tester placez le fichier joint dans le dossier à étudier.

A+
 

Pièces jointes

  • MinimumDateFichier.xlsm
    17 KB · Affichages: 6

job75

XLDnaute Barbatruc
La fonction précédente permettait d'étudier les dernières dates de modification des fichiers.

Celle-ci étudie les dates de création des fichiers :
VB:
Function MinimumDateFichier(chemin$, extension$)
Dim L As Byte, fso As Object, dat As Date, f As Object, fichier$
L = Len(extension)
Set fso = CreateObject("Scripting.FileSystemObject")
dat = CDate("31/12/9999 23:59:59")
For Each f In fso.GetFolder(chemin).Files
    If Right(f.Name, L) = extension Then _
        If CDate(f.DateCreated) < dat Then dat = CDate(f.DateCreated): fichier = f.Name
Next
MinimumDateFichier = Array(dat, fichier) 'vecteur ligne
End Function

Sub Test()
Dim a
a = MinimumDateFichier(ThisWorkbook.Path, ".pdf")
MsgBox Application.Index(a, 2) & vbLf & Application.Index(a, 1)
End Sub
 

Pièces jointes

  • MinimumDateFichier(1).xlsm
    17.2 KB · Affichages: 3

Discussions similaires

Statistiques des forums

Discussions
312 207
Messages
2 086 237
Membres
103 162
dernier inscrit
fcfg