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

Le
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 = "\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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
FdeCourt
Le #5443861
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
publicnewsgroup-fr
Le #5443851
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" 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





Domi
Le #5443821
Cela convient ;o)
Merci

"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


Publicité
Poster une réponse
Anonyme