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 &...
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"
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
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
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