Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel VBA : Edition liste de fichiers avec un critère de date

VBA : Edition liste de fichiers avec un critère de date

3 réponses
Avatar
Domi
Bonsoir,
A l'aide de cette macro (récupérée sur le forum et retouchée pour l'adapter
à mon besoin) j'édite la liste des fichiers .pdf qui sont dans un dossier
précis sur un réseau.
Je souhaiterais l'améliorer en y apportant une modification mais je n'y
parviens pas.
Je souhaiterais n'éditer que la la liste des fichiers dont la date de
création est > à la date contenue dans une cellule nommée "Datesaisie".
Quelqu'un pourrait-il m'aider ?
Merci
Domi

Sub ListePF()
Dim emplac As String, ext As String, répertoire As String
emplac = "\\Srv1\services\log\PF Contrôle"
ext = "pdf"
Sheets("Scans").Select
Range("a2:B65000").ClearContents
On Error Resume Next
répertoire = Dir(emplac & "\*" & ext, vbDirectory)
Do While répertoire <> ""
i = i + 1
Cells(i, 1) = Left(répertoire, Len(répertoire) - 4) ' Enlever le -4 si
on ne veut pas les extensions
répertoire = Dir
Loop
End Sub
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
FdeCourt
Hello,

Cela conviendrait-il ?

Sub ListePF()
Dim MaDate As Date
Dim oFileDateCreated As Date
Dim oFileName As String
Set FSO = CreateObject("Scripting.FileSystemObject")
strFolderName = ActiveWorkbook.Path
Set oSourceFolder = FSO.GetFolder(strFolderName)
MaDate = "01/04/2008"
ext = "pdf"
With Sheets("Scans")
.Range("a2:B65000").ClearContents

For Each oFile In oSourceFolder.Files
oFileDateCreated = oFile.DateCreated
oFileName = oFile.Name
If oFileDateCreated >= MaDate And UCase(Right(oFileName,
3)) = UCase(ext) Then
i = i + 1
.Cells(i, 1) = oFile.Name
End If
Next
End With
End Sub
Avatar
publicnewsgroup-fr
Bonjour Domi,

Le plus simple est à mon avie de rajouter :
Dim date1 As Date
Dim date2 As Date
date1 = Left(FileDateTime(emplac & "" & répertoire), 10)
date2 = Range("C1").Value
If (date1 > date2) Then

Ce qui veut dire :
"Si la date du fichier est plus récente que la date dans la cellule C1"

NB: Le format dans la cellule doit etre "DD/MM/YY"

Christophe Mathon

Hewlett Packard pour l'Assistance Utilisateur Microsoft

http://support.microsoft.com

Time zone: GMT


"Domi" wrote in message
news:uZP4TK%
Bonsoir,
A l'aide de cette macro (récupérée sur le forum et retouchée pour
l'adapter à mon besoin) j'édite la liste des fichiers .pdf qui sont dans
un dossier précis sur un réseau.
Je souhaiterais l'améliorer en y apportant une modification mais je n'y
parviens pas.
Je souhaiterais n'éditer que la la liste des fichiers dont la date de
création est > à la date contenue dans une cellule nommée "Datesaisie".
Quelqu'un pourrait-il m'aider ?
Merci
Domi

Sub ListePF()
Dim emplac As String, ext As String, répertoire As String
emplac = "Srv1serviceslogPF Contrôle"
ext = "pdf"
Sheets("Scans").Select
Range("a2:B65000").ClearContents
On Error Resume Next
répertoire = Dir(emplac & "*" & ext, vbDirectory)
Do While répertoire <> ""
i = i + 1
Cells(i, 1) = Left(répertoire, Len(répertoire) - 4) ' Enlever le -4
si on ne veut pas les extensions
répertoire = Dir
Loop
End Sub





Avatar
Domi
Cela convient ;o)
Merci

"FdeCourt" a écrit dans le message de news:

Hello,

Cela conviendrait-il ?

Sub ListePF()
Dim MaDate As Date
Dim oFileDateCreated As Date
Dim oFileName As String
Set FSO = CreateObject("Scripting.FileSystemObject")
strFolderName = ActiveWorkbook.Path
Set oSourceFolder = FSO.GetFolder(strFolderName)
MaDate = "01/04/2008"
ext = "pdf"
With Sheets("Scans")
.Range("a2:B65000").ClearContents

For Each oFile In oSourceFolder.Files
oFileDateCreated = oFile.DateCreated
oFileName = oFile.Name
If oFileDateCreated >= MaDate And UCase(Right(oFileName,
3)) = UCase(ext) Then
i = i + 1
.Cells(i, 1) = oFile.Name
End If
Next
End With
End Sub