cs_Gendarmette
Messages postés104Date d'inscriptionmardi 27 mai 2003StatutMembreDernière intervention14 janvier 2004
-
4 juin 2003 à 10:45
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 2021
-
4 juin 2003 à 11:28
J'aimerais comparer le contenu de 2 listbox pour trouver des fichiers au nom identique et comparer les dernieres dates de modification des 2 fichiers au meme nom pour conserver le + récent.
Je voudrais ensuite afficher les fichiers restant dans 1 3eme listbox.
Pour l'instant voila ce que j'ai fait, c'est vachement long et il y a surement des choz inutiles mais je débutr, soyez indulgents!
'Lister tous les fichiers d'un premier répertoire dans une ListBox
'
Public oFs As Scripting.FileSystemObject
Public oFolder As Scripting.Folder
Public oSubFolder As Scripting.Folder
Public oFile As Scripting.File
Public oFs2 As Scripting.FileSystemObject
Public oFolder2 As Scripting.Folder
Public oSubFolder2 As Scripting.Folder
Public oFile2 As Scripting.File
'
Private Sub BtStart_Click()
'
Dim sFolder As String
'Créer le FileSystemObject
Set oFs = CreateObject("Scripting.FileSystemObject")
'Définir le répertoire de départ
sFolder = "D:\Christine\Début"
'Rechercher les fichiers dans le répertoire de départ
Rechercher_Fichiers sFolder
'Rechercher les sous-répertoires et fichiers
Rechercher_Tout sFolder
'Afficher le nombre de fichier(s) trouvé(s)
MsgBox List1.ListCount & " fichier(s) trouvé(s) " & "dans " & sFolder
Dim sFolder2 As String
'Créer le FileSystemObject
Set oFs2 = CreateObject("Scripting.FileSystemObject")
'Définir le répertoire de départ
sFolder2 = "D:\Christine\Fin"
'Rechercher les fichiers dans le répertoire de départ
Rechercher_Fichiers2 sFolder2
'Rechercher les sous-répertoires et fichiers
Rechercher_Tout2 sFolder2
'Afficher le nombre de fichier(s) trouvé(s)
MsgBox List2.ListCount & " fichier(s) trouvé(s) " & "dans " & sFolder2
'
End Sub
'
Private Sub Rechercher_Fichiers(sFolder As String)
'
Set oFolder = oFs.GetFolder(sFolder)
'Parcourir les fichiers du répertoire et charger la listbox
For Each oFile In oFolder.Files
List1.AddItem oFile.Name
Next
'
End Sub
'
Private Sub Rechercher_Fichiers2(sFolder2 As String)
Set oFolder2 = oFs2.GetFolder(sFolder2)
'Parcourir les fichiers du répertoire et charger la listbox
For Each oFile2 In oFolder2.Files
List2.AddItem oFile2.Name
Next
'
End Sub
'
Private Sub Rechercher_Tout(sFolder As String)
'
Dim sName As String
Set oFolder = oFs.GetFolder(sFolder)
'Parcourir les sous-répertoires du répertoire
For Each oSubFolder In oFolder.SubFolders
'Composer le nom du sous-répertoire
sName = sFolder & oSubFolder.Name & ""
'Rechercher les fichiers
Rechercher_Fichiers sName
'Rechercher les sous-répertoires et fichiers récursivement
Rechercher_Tout sName
Next
'
End Sub
'
Private Sub Rechercher_Tout2(sFolder2 As String)
'
Dim sName2 As String
Set oFolder2 = oFs2.GetFolder(sFolder2)
'Parcourir les sous-répertoires du répertoire
For Each oSubFolder2 In oFolder2.SubFolders
'Composer le nom du sous-répertoire
sName2 = sFolder2 & oSubFolder2.Name & ""
'Rechercher les fichiers
Rechercher_Fichiers2 sName2
'Rechercher les sous-répertoires et fichiers récursivement
Rechercher_Tout2 sName2
Next
'
End Sub
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 4 juin 2003 à 11:10
tiens, voila une simplification de ton code:
Public oFs As Scripting.FileSystemObject
Private Sub BtStart_Click()
Dim sFolder As String
Set oFs = New FileSystemObject 'Créer le FileSystemObject
sFolder = "J:\TRANSFERT\Projects\APA\FINAL"
Call Rechercher_Fichiers(List1, sFolder, True)
MsgBox List1.ListCount & " fichier(s) trouvé(s) " & "dans " & sFolder
sFolder = "J:\TRANSFERT\Projects\APA"
Call Rechercher_Fichiers(List2, sFolder, True)
MsgBox List2.ListCount & " fichier(s) trouvé(s) " & "dans " & sFolder
End Sub
Private Sub Rechercher_Fichiers(List As ListBox, sFolder As String, Optional Recursive As Boolean = False)
Dim oFolder As Folder
Dim oSubFolder As Folder
Set oFolder = oFs.GetFolder(sFolder)
Dim oFile As File
DoEvents 'met a jour l'affichage de la liste
'Parcourir les fichiers du répertoire et charger la listbox
For Each oFile In oFolder.Files
List.AddItem oFile.Name
Next
If Recursive Then 'recherche dans les sous-repertoires
For Each oSubFolder In oFolder.SubFolders
Call Rechercher_Fichiers(List, oSubFolder.Path, True)
Next oSubFolder
End If
End Sub
est-ce que tu desires reelement utiliser les listboxes, ou est-ce juste pour le traitement ??
je suis en train d'implementer la comparaison de dates......
cs_Gendarmette
Messages postés104Date d'inscriptionmardi 27 mai 2003StatutMembreDernière intervention14 janvier 2004 4 juin 2003 à 11:24
En fait là j'utilise des listbox car je prefere faire la demarche etape par etape pour mieux me situer.
Mais normalement le traitement ne doit pas apparaitre à l'utilisateur.
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 4 juin 2003 à 11:25
Et voici la version qui trie les fichiers par rapport a la date....
(attention cependant, si des fichiers sont presents que dans une seul des 2 repertoires, ils sont ignorés......)
Public oFs As Scripting.FileSystemObject
Private Type type_Fichier
Path As String
Name As String
Date As Date
End Type
Private Sub BtStart_Click()
Dim sFolder As String
Set oFs = New FileSystemObject 'Créer le FileSystemObject
'on cree des listes de fichiers
Dim Fichiers_Rep1() As type_Fichier
Dim Fichiers_Rep2() As type_Fichier
Dim Fichiers_Arrivee() As type_Fichier
'pour eviter une erreur de dimensionnement plus tard , condamne l'indice 0....
ReDim Fichiers_Rep1(0)
ReDim Fichiers_Rep2(0)
ReDim Fichiers_Arrivee(0)
List1.Clear
List2.Clear
List3.Clear
'on remplis le tableau de fichiers 1
sFolder = "c:\Repertoire1"
Call Rechercher_Fichiers(sFolder, Fichiers_Rep1, True)
'on place ces fichiers dans la listbox
Call RemplirListbox(List1, Fichiers_Rep1)
MsgBox List1.ListCount & " fichier(s) trouvé(s) " & "dans " & sFolder
'idem pour le repertoire2
sFolder = "c:\Repertoire2"
Call Rechercher_Fichiers(sFolder, Fichiers_Rep2, True)
Call RemplirListbox(List2, Fichiers_Rep2)
MsgBox List2.ListCount & " fichier(s) trouvé(s) " & "dans " & sFolder
'on recupere la liste triée, et on la place dans le troisieme listbox
Call TriDates(Fichiers_Rep1, Fichiers_Rep2, Fichiers_Arrivee)
Call RemplirListbox(List3, Fichiers_Arrivee)
End Sub
'remplis une listbox avec le nom des fichiers issus d'une liste
Private Sub RemplirListbox(List As ListBox, Fichiers() As type_Fichier)
Dim a As Integer
For a = 1 To UBound(Fichiers)
List.AddItem Fichiers(a).Name
Next a
End Sub
'parcours les deux premiers tableaux de fichiers, et ajoute dans le troisieme , les fichiers les plus recents
Private Sub TriDates(Fichiers1() As type_Fichier, Fichiers2() As type_Fichier, FichiersSortie() As type_Fichier)
Dim a As Integer, b As Integer
'on parcours les deux listes
For a = 1 To UBound(Fichiers1)
For b = 1 To UBound(Fichiers2) If 0 StrComp(Fichiers1(a).Path, Fichiers2(b).Path) Then 'equivalent a " if fichiers1(a).path fichiers2(b).path Then " mais plus rapide
ReDim Preserve FichiersSortie(1 + UBound(FichiersSortie))
If Fichiers1(a).Date >= Fichiers2(b).Date Then 'garde le fichier le plus recent
FichiersSortie(UBound(FichiersSortie)) = Fichiers1(a)
Else
FichiersSortie(UBound(FichiersSortie)) = Fichiers2(b)
End If
End If
Next b
Next a
End Sub
'liste les fichiers et les place dans un tableau
'le dernier parametre sert a indiquer que la recherche dois s'effectuer dans les sous-repertoires
Private Sub Rechercher_Fichiers(sFolder As String, Fichiers() As type_Fichier, Optional Recursive As Boolean = False)
Dim oFolder As Folder
Dim oSubFolder As Folder
Set oFolder = oFs.GetFolder(sFolder)
Dim oFile As File
DoEvents 'evite de figer l'application si la recherche est longue
'Parcourir les fichiers du répertoire et remplis le tableau
For Each oFile In oFolder.Files
ReDim Preserve Fichiers(1 + UBound(Fichiers))
' recupere les infos sur les fichiers
With Fichiers(UBound(Fichiers))
.Name = oFile.Name
.Path = oFile.Path
.Date = oFile.DateLastModified
End With
Next
If Recursive Then 'recherche dans les sous-repertoires
For Each oSubFolder In oFolder.SubFolders
Call Rechercher_Fichiers(oSubFolder.Path, Fichiers(), True)
Next oSubFolder
End If
End Sub