Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
1685 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Tri d'un fichier texte par date

 
 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Tri d'un fichier texte par date

n°1381897
dragonbool​s
Posté le 06-06-2006 à 11:25:59  profilanswer
 

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

mood
Publicité
Posté le 06-06-2006 à 11:25:59  profilanswer
 

n°1382306
dragonbool​s
Posté le 06-06-2006 à 18:33:19  profilanswer
 

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?

n°1382328
kiki29
Posté le 06-06-2006 à 19:13:45  profilanswer
 

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
n°1382352
dragonbool​s
Posté le 06-06-2006 à 19:45:13  profilanswer
 

je te remercie ....
 
je me penche la dessus et vous ferez un petit backup

n°1382562
dragonbool​s
Posté le 07-06-2006 à 09:27:31  profilanswer
 

Voila j ai ca:
 

Code :
  1. Option Explicit
  2. Const Path = "F:\Mes Films"
  3. MsgBox ShowFolderList(Path),,"Liste des fichiers du répertoire """ & Path &vbCrLf&_
  4.       """ triés par date de modification (du + récent au + ancien)"
  5. Function ShowFolderList(strPath)
  6. Dim fso, Dossiers, fic, fichiers, strListe, f, r
  7. Dim Valeur, imax, z, Cible, liste
  8.     Set fso = CreateObject("Scripting.FileSystemObject" )
  9.     Set Dossiers = fso.GetFolder(Path)
  10.     Set fic = Dossiers.Files
  12.     imax = 0
  13.     For Each fichiers In fic
  14.         Set f = fso.GetFile(fichiers)
  15.         imax = imax + 1
  16.         ReDim Preserve Tableau(2, imax)
  17.         Tableau(1, imax) = f.Name
  18.         Tableau(2, imax) = f.DateCreated
  19.        
  20.         Valeur = 0
  21.         For imax = 1 To imax - 1
  22.             If CDate(Tableau(2, imax)) < CDate(Tableau(2, imax + 1)) Then
  23.                For z = 1 To 2
  24.                    Cible = Tableau(z, imax)
  25.                    Tableau(z, imax) = Tableau(z, imax + 1)
  26.                    Tableau(z, imax + 1) = Cible
  27.                Next
  28.                Valeur = 1
  29.             End If
  30.         Next
  31.     Next
  33. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  34. ' Affichage du résultat des fichiers triés par date de modification
  35. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  36.     liste = ""
  37.     For r = 1 To imax
  38.         liste = liste & vbCrLf & r & " " & Tableau(2, r) & " " & Tableau(1, r)
  39.     Next
  40.     liste = vbCrLf& "N° Date de modification Nom du fichier" &vbCrLf& liste
  41.     ShowFolderList = liste
  42.    
  43.     Set fso = Nothing
  44.     Set Dossiers = Nothing
  45.     Set fic = Nothing
  46.     Set f = Nothing
  48. 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
n°1382774
kiki29
Posté le 07-06-2006 à 12:31:05  profilanswer
 

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

n°1383140
kiki29
Posté le 07-06-2006 à 19:48:11  profilanswer
 


 
'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

Aller à :
Ajouter une réponse
  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 .xlsquestion sur un fichier cmd
Comment ouvrir un fichier Temporary Internet Files et le copierfopen et fichier window...
envoi de formulaire à plusieurs champs de textefichier autoextractible
[PERL] Parse d'un fichier de configuration[VBA Excel] Chemin fichier ouvrir
Plus de sujets relatifs à : Tri d'un fichier texte par date

Forum MesDiscussions.Net, Version 2010.2
(c) 2000-2011 Doctissimo
Page générée en 0.066 secondes

Copyright © 1997-2025 Groupe LDLC (Signaler un contenu illicite / Données personnelles)