Discussion :

[modus57]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.
@+

[Franc]

Salut, as-tu pensé à mettre la propriété ColumnCount de la listbox à 3 ? Par défaut c'est 1.

[modus57]

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

[Valtrase]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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...

[modus57]

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

Je cherche une éventuelle solution en attendant votre réponse.

@+

[Nain porte koi]

Hello,

en reprenant l'exemple de Valtrase je propose ceci

[Valtrase]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[modus57]

Bonjour Nain porte koi,

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é :

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

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

@+

[modus57]

Bonjour Valtraze.

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 ?

@+

[Valtrase]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[modus57]

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 :


En revanche s’il en comporte comme sur l’image ci-dessous exemple "maxdesk.ini2" , "Thumbs.db" …

Comme faire pour éviter de les afficher ??
Merci c’avance pour votre contribution.
@+

[modus57]

Bonjour @tous,
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.

[patmeziere]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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