XL 2010 Lister certains fichiers (dossier/ sous-dossiers)

cathodique

XLDnaute Barbatruc
Bonjour,

Il y a un moment Job75 et Sylvanu m'ont aidé pour lister dans une listbox certains fichiers se trouvant dans le même répertoire que mon fichier.
Tout fonctionnait très bien. Ce fichier me sert à retrouver des bouts de codes. J'ai créé donc des sous-dossiers pour classer ces fichiers par catégories.
J'ai bien trouvé des exemples répertoriant les fichiers des sous-répertoires. Je n'arrive pas à adapter à mon cas qui doit aussi prendre en compte l'extension des fichiers.

En espérant, avoir bien exposé mon problème. Je joins un fichier zippé pour illustrer mon cas.

En vous remerciant par avance.

Bonne journée.
 

Pièces jointes

  • MonDossier.zip
    24.2 KB · Affichages: 12
Solution
Si l'on veut aussi récupérer le fichier .txt du dossier principal ajouter une boucle :
VB:
Dim liste$() 'mémorise la variable

Private Sub UserForm_Initialize()
Dim chemin$, fso As Object, f As Object, sf As Object, n&
chemin = ThisWorkbook.Path & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
For Each f In fso.GetFolder(chemin).Files
    If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(f.Name, 4) & "/") Then
        ReDim Preserve liste(n)
        liste(n) = f.Name
        n = n + 1
    End If
Next f
For Each sf In fso.GetFolder(chemin).SubFolders
    For Each f In sf.Files
        If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(f.Name, 4) & "/") Then
            ReDim Preserve liste(n)
            liste(n) = f.Name
            n =...

job75

XLDnaute Barbatruc
Bonjour cathodique,

Pour ce qui me concerne :
VB:
Dim liste$() 'mémorise la variable

Private Sub UserForm_Initialize()
Dim chemin$, fso As Object, sf As Object, f As Object, n&
chemin = ThisWorkbook.Path & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
For Each sf In fso.GetFolder(chemin).SubFolders
    For Each f In sf.Files
        If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(f.Name, 4) & "/") Then
            ReDim Preserve liste(n)
            liste(n) = f.Name
            n = n + 1
        End If
Next f, sf
If n Then ListBox1.List = liste Else ListBox1.Clear
End Sub
A+
 

Pièces jointes

  • MonDossier.zip
    27.2 KB · Affichages: 9

job75

XLDnaute Barbatruc
Si l'on veut aussi récupérer le fichier .txt du dossier principal ajouter une boucle :
VB:
Dim liste$() 'mémorise la variable

Private Sub UserForm_Initialize()
Dim chemin$, fso As Object, f As Object, sf As Object, n&
chemin = ThisWorkbook.Path & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
For Each f In fso.GetFolder(chemin).Files
    If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(f.Name, 4) & "/") Then
        ReDim Preserve liste(n)
        liste(n) = f.Name
        n = n + 1
    End If
Next f
For Each sf In fso.GetFolder(chemin).SubFolders
    For Each f In sf.Files
        If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(f.Name, 4) & "/") Then
            ReDim Preserve liste(n)
            liste(n) = f.Name
            n = n + 1
        End If
Next f, sf
If n Then ListBox1.List = liste Else ListBox1.Clear
End Sub
 

Pièces jointes

  • MonDossier.zip
    27.7 KB · Affichages: 19

cathodique

XLDnaute Barbatruc
Si l'on veut aussi récupérer le fichier .txt du dossier principal ajouter une boucle :
VB:
Dim liste$() 'mémorise la variable

Private Sub UserForm_Initialize()
Dim chemin$, fso As Object, f As Object, sf As Object, n&
chemin = ThisWorkbook.Path & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
For Each f In fso.GetFolder(chemin).Files
    If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(f.Name, 4) & "/") Then
        ReDim Preserve liste(n)
        liste(n) = f.Name
        n = n + 1
    End If
Next f
For Each sf In fso.GetFolder(chemin).SubFolders
    For Each f In sf.Files
        If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(f.Name, 4) & "/") Then
            ReDim Preserve liste(n)
            liste(n) = f.Name
            n = n + 1
        End If
Next f, sf
If n Then ListBox1.List = liste Else ListBox1.Clear
End Sub
Bonjour Job75;),

C'est impeccable:cool:. Tu me sauves, je vais pouvoir enfin me faire ma petite bibliothèque de code.

Avec toute ma gratitude et mes remerciements.


:cool::cool:
 

cathodique

XLDnaute Barbatruc
Bonjour Job75;), Le forum,

J'ai crié victoire trop vite! J'ai voulu modifier ton code pour récupérer aussi le chemin complet des fichiers. Sans y parvenir.
VB:
Option Explicit
Dim liste$() 'mémorise la variable

Private Sub UserForm_Initialize()
    Dim chemin$, fso As Object, f As Object, sf As Object, n&
    chemin = ThisWorkbook.Path & "\"
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each f In fso.GetFolder(chemin).Files
        If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(f.Name, 4) & "/") Then
            'ReDim Preserve liste(n)    'initial
            ReDim Preserve liste(1 To 2, 1 To n)   ' plante ici "l'indice n'appartient pas à la selection" '
            'liste(n) = f.Name      'initial
            liste(1, n) = f.Name
            liste(2, n) = f.Path
            n = n + 1
        End If
    Next f
    For Each sf In fso.GetFolder(chemin).SubFolders
        For Each f In sf.Files
            If InStr("/.bas/.txt/.cls/.frm/", "/" & Right(f.Name, 4) & "/") Then
                'ReDim Preserve liste(n)        'initial
                ReDim Preserve liste(1 To 2, 1 To n)
                'liste(n) = f.Name      'initial
                liste(1, n) = f.Name
                liste(2, n) = f.Path
                n = n + 1
            End If
        Next f, sf
        'If n Then ListBox1.List = liste Else ListBox1.Clear        'initial
        If n Then ListBox1.List = Application.Transpose(liste) Else ListBox1.Clear
    End Sub
L'idée est qu'au choix dans listbox1, on puisse affiche le contenu du fichier dans listbox2.
Je joins le fichier complété.

Avec mes remerciements anticipés.
 

Pièces jointes

  • AlimenterListBoxFichiersExtention(2).xlsm
    21.8 KB · Affichages: 13

Discussions similaires

Réponses
19
Affichages
2 K
Réponses
36
Affichages
1 K

Statistiques des forums

Discussions
311 713
Messages
2 081 806
Membres
101 819
dernier inscrit
lukumubarth