Liste des fichiers dans une ListBox en fonction de l’extension choisie dans une autre ListBox

Version imprimable

Bonjour,

Je fais à nouveau appel à votre aide afin de régler un petit souci que j'ai pour lister les fichiers dans une ListBox en fonction de l’extension choisie dans une première ListBox.

Après la sélection du dossier, la liste des extensions des fichiers contenus dans celui-ci s’affiche dans la première ListBox et suite au choix d’une extension, la liste des fichiers ayant cette extension s’affiche dans la deuxième ListBox.

La procédure pour la phase du choix d’un dossier et lister les extinctions des fichiers se passa bien.

Voici le code de la ListBox qui liste les extensions :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 Private Sub TypeFich_Change() Dim indtype As Long Dim n ReDim Preserve Tbl(0) ListBox1.Clear nf = Dir(Me.répertoire.Value & "\" & Me.TypeFich) 'prévoir le cas où l'extension du fichier n'est pas trouvé dans le dossier If nf = "" Then Me.ListBox1.Clear Me.TextBox1 = "0 Fichier" Exit Sub End If n = 0 Do While nf <> "" indtype = 0 Do If nf Like TypeFich.List(indtype) And TypeFich.Selected(indtype) Then n = n + 1 ReDim Preserve Tbl(n) Tbl(n) = nf Else ListBox1.List = Range("Tableau1").Value End If indtype = indtype + 1 Loop Until indtype > TypeFich.ListCount - 1 nf = Dir Loop If n > 0 Then Me.ListBox1.List = Tbl Me.TextBox1 = Me.ListBox1.ListCount & IIf(Me.ListBox1.ListCount > 1, " Fichiers", " Fichier") End Sub
Mais dans la deuxième ListBox de 3 colonnes (Nom fichier, Date, Taille) qui liste les fichiers en fonction de l’extension choisie, ne s’affiche que la première colonne.

Que faut-il modifier pour afficher la 2ème et la 3ème colonnes.

Merci d’avance pour votre aide.
@+

02/10/2024, 23h14
Franc

Salut, as-tu pensé à mettre la propriété ColumnCount de la listbox à 3 ? Par défaut c'est 1.
03/10/2024, 00h28
modus57

Oui la propriété ColumnCount de la listbox est à 3.

Bonjour,
Tu peux utiliser le Sheel pour arriver à ce résultat, j'ai renommé ListBox1 en Files :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub TypeFich_Change()
    If Répertoire.Value > vbNullString Then
        Files.Clear
        Dim TempString As String
        TempString = Replace("cmd /c Dir ""*****"" /b /a-d", "*****", CStr(Me.Répertoire.Value) & "*." & TypeFich.Value, 1, -1, vbTextCompare)
        Debug.Print TempString
        Files.List = Filter(Split(CreateObject("wscript.shell").exec(TempString).stdout.readall, vbCrLf), ".")
    Else
        MsgBox "Sélectionner d'abord un répertoire !"
        TypeFich.ListIndex = -1
        Répertoire.SetFocus
    End If
 
 
End Sub

Un petit exemple de classeur : Pièce jointe 660050

Bonne programmation...;)

04/10/2024, 09h18
modus57

1 pièce(s) jointe(s)

Bonjour Valtrase et merci de vous intéressez à cette discussion.

Je me suis absenté d’où ma réponse tardive.

C’est pas mal mais ça ne répond pas tout à fait à ma question :

1 . si le « xls » est le choix de l’extension le ComboBox affiche les fichiers qui ont une extention « xls » et « xlsm »

2 . il n’affiche pas les caractères accentués

3. ni la date de création et la taille du fichier
Pièce jointe 660082
Je cherche une éventuelle solution en attendant votre réponse.

@+
04/10/2024, 11h04
Nain porte koi

1 pièce(s) jointe(s)

Hello,

en reprenant l'exemple de Valtrase je propose ceci

Bonjour,
Effectivement ce n'était pas bon.
Voici une fonction à qui on fournit l'objet à remplir, le filtre exemple : "xl*", et le répertoire à traiter.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
'@Description "Rempli la zone de liste."
Private Sub FillTheList(ByVal Liste As Object, Optional ByVal Filter As Variant, Optional ByVal Directory As Variant)
 
    Dim Fso As Object
    Dim Folder As Object
    Dim SearchedFile As Object
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
 
    If IsMissing(Filter) Or Filter = vbNullString Then
        Filter = "*.*"
    End If
 
    If IsMissing(Directory) Or Directory = vbNullString Then
        With ThisWorkbook
            Directory = .Path & IIf(Right$(.Path, 1) = "\", .Path, .Path & "\")
        End With
    End If
 
    Set Folder = Fso.GetFolder(Directory)
    With Liste
        .Clear
        For Each SearchedFile In Folder.Files
            If (SearchedFile.Attributes And 2) = 0 Then
                If LCase$(Fso.GetExtensionName(SearchedFile.Name)) Like Filter Then
                    .AddItem SearchedFile.Name
                    .List(.ListCount - 1, 1) = Format$(SearchedFile.Size / 1024, "0.00") & " KB"
                    .List(.ListCount - 1, 2) = Format$(SearchedFile.DateLastModified, "general date")
                End If
            End If
        Next SearchedFile
    End With
End Sub

Dans une procédure mettre :

Code:

FillTheList Liste:=ListBox1, Filter:="xl*", Directory:=ThisWorkbook.Path

Le projet revu avec un exemple minimaliste de gestion du ruban : Pièce jointe 660101

nb: Pour la programation vous pouvez vous inspirer du très bon article de Philippe Tulliez sur le Early et LateBinding

04/10/2024, 17h01
modus57
Bonjour Nain porte koi, :D

Votre proposition est intéressante et en remplaçant le ComboBOx par un ListBox (caption files) c’est encore plus intéressant.

J’ai remplacé :

Citation:

Me.files.AddItem NomFich.Name & Chr(9) & NomFich.DateCreated & Chr(9) & Taille_Fichier

par
Code:

1 2 3 4 5 6 7 8 9 With Me.files .ColumnCount = 3 .ColumnWidths = "184;84" .AddItem .List(i, 0) = NomFich.Name .List(i, 1) = NomFich.DateCreated .List(i, 2) = Taille_Fichier i = i + 1 End With
Et pour rendre le formulaire et le ListBox dynamique j’ai ajouté :
Code:

1 2 UserForm1.Height = UserForm1.Height + files.Font.Size * (files.ListCount) Me.files.Height = files.Font.Size * (files.ListCount) * 1.4
Valtrase je vais examiner votre dernière solution et je vous tiens au courant.

@+
05/10/2024, 09h07
modus57

Bonjour Valtraze. :D

Votre dernière solution est pas mal aussi.

En remplaçant le ComboBOx pat un ListBox (caption FilesList) c’est encore mieux.

Comment récupérer la date de création et la taille des fichiers ?

@+

Bonjour,
Oupss... c'est de ma faute j'ai supprimé les colonnes de la liste déroulante.

Il faut modifier la procédure FillTheList comme ceci. Ajoutez les lignes en gras.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
'@Description "Rempli la zone de liste."
Private Sub FillTheList(ByVal Liste As Object, Optional ByVal Filter As Variant, Optional ByVal Directory As Variant)
    
    Dim Fso As Object
    Dim Folder As Object
    Dim SearchedFile As Object


    Set Fso = CreateObject("Scripting.FileSystemObject")


    If IsMissing(Filter) Or Filter = vbNullString Then
        Filter = "*.*"
    End If


    If IsMissing(Directory) Or Directory = vbNullString Then
        With ThisWorkbook
            Directory = .Path & IIf(Right$(.Path, 1) = "\", .Path, .Path & "\")
        End With
    End If


    Set Folder = Fso.GetFolder(Directory)
    With Liste
        .ColumnCount = 3
        .BoundColumn = 1
        .ColumnWidths = "350;50;80"
        .Clear
        For Each SearchedFile In Folder.Files
            If (SearchedFile.Attributes And 2) = 0 Then
                If LCase$(Fso.GetExtensionName(SearchedFile.Name)) Like Filter Then
                    .AddItem SearchedFile.Name
                    .List(.ListCount - 1, 1) = Format$(SearchedFile.Size / 1024, "0.00") & " KB"
                    .List(.ListCount - 1, 2) = Format$(SearchedFile.DateLastModified, "general date")
                End If
            End If
        Next SearchedFile
    End With
End Sub

ps: Vous pouvez aussi définir ces propriétés à la création du formulaire dans la fenêtre de conception en sélectionnant la zone de liste et modifiant ses propriétés.

Pièce jointe 660129

10/12/2024, 00h12
modus57

2 pièce(s) jointe(s)

Bonsoir,
Je reviens sur cette discussion, car je rencontre un petit souci.
En effet jusqu’à présent les dossiers consultés ne comprenaient pas de fichiers System ou Caché voir image ci-dessous :
Pièce jointe 662649

En revanche s’il en comporte comme sur l’image ci-dessous exemple "maxdesk.ini2" , "Thumbs.db" …
Pièce jointe 662650
Comme faire pour éviter de les afficher ??
Merci c’avance pour votre contribution.
@+
12/12/2024, 07h59
modus57

Bonjour @tous, :coucou:
Alors, pas la moindre petite idée pour ignorer les fichiers cachés avec "CreateObject("Scripting.FileSystemObject")" ??
Si ce n'est pas possible je mets la discussion en résolue !
Merci d'avance pour vos réponses.

Bonjour
bien sur que si ;il y a des solutions
1° les méthodes FSO utilisée de la mauvaise manière et pour de mauvaises raison n'est pas une solution
2° avec un simple dir de VBA (qui est incontestablement plus rapide en lecture complète)tu peux paramétrer ta lecture de ton dossier

voici une petite fonction qui va s'occuper de tout
entendons nous bien il s'agit là de lister les fichiers dans un dossiers il n'y a pas de récursivité pour aller chercher des eventuels fichiers dans les sous dossiers

oui mais alors comment fait on
pour commencer le dir de vba a deux methodes
-----------------------------------------------------------------
Méthode 1: truc=dir("chemin complet du fichier avec jocker ou pas")
cette methode 1 est utilisée le plus souvent pour tester l'existence d'un fichier
ou pour récupérer le chemin exact d'un fichier dont on a pas toutes les données
exemple : monFichier= dir("C:\mondossier\truc*bidule*.xl*")
-----------------------------------------------------------------

Méthode 2: truc=dir(chemin du Folder, critères)

oui mais alors c'est quoi ces critères
ces critères sont

VbDirectory
VbNormal
VbSystem
VBHidden
VBArchive

cette méthode va lister les nom des fichiers et celui des sous dossiesr de premier niveau (sans distinction)
et c'est avec les critères que l'on va limiter le listage des occurrences trouvées dans le dossier

ici dans ton cas on veut récupérer les fichiers avec une extension précise
ce sera donc pour le depart truc=Dir(chemin du folder,vbdirectory and vbnormal and not vbSystem and not VbHidden)
nous venons additionner logiciellement les critères (Addition logique)
et je dis bien logiciellement pas mathématiquement , ce n'est absolument pas la même chose ne surtout pas confondre sinon c'est la confusion

il nous reste plus qu'a boucler en relançant un new dir en fin de looping
et entre temps on sélectionnera ce qui nous intéresse
a savoir

pas les sous dossiers
uniquement les fichiers ayant l'extension demandée

a fin d'avoir une fonction un peu passe partout l'extension sera optionnelle comme ça(si omis) cette fonction pourra lister tout les fichiers
j'aime bien le recyclage moi;)

alors voici enfin une fonction avec sub de test qui résume ce qui vient d'être dit ci dessus
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 Sub test() lFolder = "K:\VBA EXCEL\" 'lFolder a adapter Extension = ".xls" 'extension à adapter tabl = ListFileByExtension(lFolder, Extension) 'récupération de la liste avec la fonction Cells(1, 1).Resize(UBound(tabl), UBound(tabl, 2)) = tabl 'exemple pour ta combobox 'tacombobox.List = ListFileByExtension(lFolder, Extension) End Sub Function ListFileByExtension(lFolder, Optional ext = ".*") 'created patmeziere Allias patricktoulon for @MODUS57 12/12/2024 Dim I& Dim Criteres As Long Dim ItemVu As String Dim tbl() ReDim tbl(1 To 3, 1 To 1) '**************************************************** 'ici on determine les critères de grabb 'comme on va lister on démarre par vbdirectory ensuite les normal pas les system pas les cachés 'il est bien évident que les sous dossiers vont être exemptés dans cette version et cela sera géré dans les instructions conditionnelles 'c'est ce que l'on appelle une addition logique et non mathématique critères = vbDirectory And vbNormal And Not vbSystem And Not vbHidden '******************************************************* ItemVu = Dir(lFolder, Criteres) 'dir avec critères Do While ItemVu <> "" If Left(ItemVu, 1) <> "." Then If (GetAttr(lFolder & ItemVu) And vbDirectory) <> vbDirectory Then If ext = ".*" Then ext = Right(ItemVu, 4) If Right(ItemVu, Len(ext)) = ext Then I = I + 1: ReDim Preserve tbl(1 To 3, 1 To I) tbl(1, I) = ItemVu tbl(2, I) = FileDateTime(lFolder & ItemVu) tbl(3, I) = FileLen(lFolder & ItemVu) / 1000 & "Ko" End If End If End If ItemVu = Dir Loop ListFileByExtension = Application.Transpose(tbl) End Function
je vais ouvrir un topic dans mon blog prochainement pour vous montrer comment on peut faire avec diverses méthodes et comment les accélérer
car le temps d'exécution de ce genre de fonction est le fer de lance
je vous montrerais comment j'accélère FSO au niveau de dir
et diverses autres méthodes de récursivité notamment ma petite dernière avec un dir intra récursif et non fonction récursif que j'ai appelé méthode Pile
je vous montrerais aussi que les méthodes avec un shell sur une ligne de commande sont en fait les plus lentes parmis plus rapides
et tout cela avec test Benchmark à l'appui

assez de Blablabla
je te propose d'essayer cette fonction ci dessus
patrick