Tri d'un fichier texte par date

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : Tri d'un fichier texte par date

dragonbools

Bonjour tout le monde.

Je cherche depuis un moment a lister le contenu d un repertoire et de ses sous repertoire pour en suite afficher les resultats du plus recent fichier au plus ancien... (c est dur a expliquer.. dites moi si c est pas clair).

Pour lister le contenu du repertoire c est pas facile pour moi qui ne connait rien en vb)... mais je demande surtout votre aide pour lister aussi le contenu dessous repertoire et classer tout ca par date...

Alors si vous avez des infos... je suis preneur! Merci a vous

Publicité

dragonbools

changement tactique car c est plus simple...

Savez vous comment retourner les 10 fichiers les plus recents d un repertoire et de tous les sous repertoires qui le compose?

kiki29

A adapter

Option Explicit

' Dans environnement VBA
' Outils | Références cocher Microsoft Scripting Runtime

Private Sub TestListeFichiersDansDossier()
Const Dossier As String = "C:\Transfert\"

Application.ScreenUpdating = False
Cells.Clear
Range("A3" ).Formula = "Nom:"
Range("B3" ).Formula = "Taille:"
Range("C3" ).Formula = "Type:"
Range("D3" ).Formula = "Date Création:"
Range("E3" ).Formula = "Date Dernier Accès:"
Range("F3" ).Formula = "Date Dernière Modif:"
Range("A3:F3" ).Font.Bold = True
Range("A2" ).Select

' s'il n'y a pas de sous dossiers à visiter
' sinon ListeFichiersDansDossier Dossier, True
ListeFichiersDansDossier Dossier, False
Application.ScreenUpdating = True
End Sub

Private Sub ListeFichiersDansDossier(ByVal NomDossierSource As String, ByVal InclureSousDossiers As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder, SousDossier As Scripting.Folder
Dim Fichier As Scripting.File
Dim r As Long
Set FSO = New Scripting.FileSystemObject
Set DossierSource = FSO.GetFolder(NomDossierSource)

r = Range("A65536" ).End(xlUp).Row + 1
For Each Fichier In DossierSource.Files
'Cells(r, 1).Formula = Fichier.Path
Cells(r, 1).Formula = Fichier.Name
Cells(r, 2).Formula = Fichier.Size
Cells(r, 3).Formula = Fichier.Type
Cells(r, 4).Formula = Fichier.DateCreated
Cells(r, 5).Formula = Fichier.DateLastAccessed
Cells(r, 6).Formula = Fichier.DateLastModified
r = r + 1
Next Fichier
If InclureSousDossiers Then
For Each SousDossier In DossierSource.SubFolders
ListeFichiersDansDossier SousDossier.Path, True
Next SousDossier
End If
Columns("A:H" ).AutoFit
Set Fichier = Nothing
Set DossierSource = Nothing
Set FSO = Nothing
End Sub

Message édité par kiki29 le 01-12-2006 à 02:29:44

dragonbools

je te remercie ....

je me penche la dessus et vous ferez un petit backup

dragonbools

Voila j ai ca:

Code :

Option Explicit
Const Path = "F:\Mes Films"
MsgBox ShowFolderList(Path),,"Liste des fichiers du répertoire """ & Path &vbCrLf&_
""" triés par date de modification (du + récent au + ancien)"
Function ShowFolderList(strPath)
Dim fso, Dossiers, fic, fichiers, strListe, f, r
Dim Valeur, imax, z, Cible, liste
Set fso = CreateObject("Scripting.FileSystemObject" )
Set Dossiers = fso.GetFolder(Path)
Set fic = Dossiers.Files
imax = 0
For Each fichiers In fic
Set f = fso.GetFile(fichiers)
imax = imax + 1
ReDim Preserve Tableau(2, imax)
Tableau(1, imax) = f.Name
Tableau(2, imax) = f.DateCreated
Valeur = 0
For imax = 1 To imax - 1
If CDate(Tableau(2, imax)) < CDate(Tableau(2, imax + 1)) Then
For z = 1 To 2
Cible = Tableau(z, imax)
Tableau(z, imax) = Tableau(z, imax + 1)
Tableau(z, imax + 1) = Cible
Next
Valeur = 1
End If
Next
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Affichage du résultat des fichiers triés par date de modification
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
liste = ""
For r = 1 To imax
liste = liste & vbCrLf & r & " " & Tableau(2, r) & " " & Tableau(1, r)
Next
liste = vbCrLf& "N° Date de modification Nom du fichier" &vbCrLf& liste
ShowFolderList = liste
Set fso = Nothing
Set Dossiers = Nothing
Set fic = Nothing
Set f = Nothing
End Function

Maintenant il faut que je l'adapte au balayage des sous-dossiers et ce sera parfait...

Message édité par dragonbools le 07-06-2006 à 09:28:42

kiki29

Une remarque en voyant le code que j'ai posté
Dans TestListeFichiersDansDossier() remplacer ListeFichiersDansDossier Dossier, False par ListeFichiersDansDossier Dossier, True pour que le balayage prenne en compte les sous dossiers

kiki29

'Outils | Références Cocher Microsoft Scripting Runtime
'Nommer la zone A2..C65536 en ZoneTri
'Affecter un Bouton à TestListeFichiersDansDossier
' en mettant auparavant TestListeFichiersDansDossier en Public et non Private
'Si recursion Dossier/Sous Dossiers
' ListeFichiersDansDossier Dossier, True sinon ListeFichiersDansDossier Dossier, False

Option Explicit

Private Sub TestListeFichiersDansDossier()
Dim Dossier As String
Application.ScreenUpdating = False
Cells.Clear
' Dossier de test à adapter
Dossier = "D:\Backup\Perso\"

' s'il n'y a pas de sous dossiers à visiter
' ListeFichiersDansDossier Dossier, False
ListeFichiersDansDossier Dossier, True
Tri
MiseEnPage
Application.ScreenUpdating = True
End Sub

Private Sub ListeFichiersDansDossier(ByVal NomDossierSource As String, ByVal InclureSousDossiers As Boolean)
Dim FSO As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder, SousDossier As Scripting.Folder
Dim Fichier As Scripting.File
Dim r As Long
Set FSO = New Scripting.FileSystemObject
Set DossierSource = FSO.GetFolder(NomDossierSource)

r = Range("A65536" ).End(xlUp).Row + 1
For Each Fichier In DossierSource.Files
Application.StatusBar = r - 1
Cells(r, 1).Formula = Fichier.DateCreated
Cells(r, 2).Formula = Fichier.DateLastModified
Cells(r, 3).Formula = Fichier.Path
'Cells(r, 3).Formula = Fichier.Name
r = r + 1
Next Fichier
If InclureSousDossiers Then
For Each SousDossier In DossierSource.SubFolders
ListeFichiersDansDossier SousDossier.Path, True
Next SousDossier
End If

Set Fichier = Nothing
Set DossierSource = Nothing
Set FSO = Nothing
End Sub

Private Sub MiseEnPage()
Range("A1" ).Formula = "Date Création "
Range("B1" ).Formula = "Date Dernière Modification"
Range("C1" ).Formula = "Nom"
Range("A1:C1" ).Font.Bold = True

Columns("A:C" ).AutoFit
Columns("A:B" ).HorizontalAlignment = xlCenter

Rows("1:1" ).Select
With Selection
.RowHeight = 30
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
End With

With ActiveWindow
.ScrollRow = 1
.ScrollColumn = 1
End With
Range("D1" ).Select
End Sub

Private Sub Tri()
Range("ZoneTri" ).Sort Key1:=Range("B2" ), Order1:=xlDescending, _
Key2:=Range("A2" ), Order2:=xlAscending, _
Key3:=Range("C2" ), Order3:=xlAscending
End Sub

Message édité par kiki29 le 01-12-2006 à 02:35:50

FORUM HardWare.fr

Programmation

VB/VBA/VBS

Tri d'un fichier texte par date

Sujets relatifs
Ouverture de fichier en lecture, bloquante ou pas ?	mise en page texte de resultat de recherche propre
"RESOLU" Macro ou lien hypertexte pour ouvrir un fichier .xls	question sur un fichier cmd
Comment ouvrir un fichier Temporary Internet Files et le copier	fopen et fichier window...
envoi de formulaire à plusieurs champs de texte	fichier autoextractible
[PERL] Parse d'un fichier de configuration	[VBA Excel] Chemin fichier ouvrir
Plus de sujets relatifs à : Tri d'un fichier texte par date

Page générée en 0.064 secondes