Comparer 2 listbox

Question

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

Merci d'avance.

Renfield · Answer

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......

 By Renfield 

[mailto:thomas_reynald@msn.com mailto:thomas_reynald@msn.com]

Aucune touche n'a été bléssée lors de la saisie de ce texte.......... ;)

cs_Gendarmette · Answer

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 · Answer

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


By Renfield

[mailto:thomas_reynald@msn.com mailto:thomas_reynald@msn.com]

Aucune touche n'a été bléssée lors de la saisie de ce texte.......... ;)

Renfield · Answer

voila, c'est bon :

[mailto:thomas_reynald@msn.com mailto:thomas_reynald@msn.com]

Aucune touche n'a été bléssée lors de la saisie de ce texte.......... ;)

Comparer 2 listbox

4 réponses

Discussions similaires