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

[cathodique]

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.

 

[job75]

Bonjour cathodique,

Pour ce qui me concerne :

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+

 

[job75]

Si l'on veut aussi récupérer le fichier .txt du dossier principal ajouter une boucle :

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

 

[cathodique]

Si l'on veut aussi récupérer le fichier .txt du dossier principal ajouter une boucle :

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. Tu me sauves, je vais pouvoir enfin me faire ma petite bibliothèque de code.

Avec toute ma gratitude et mes remerciements.

 

[cathodique]

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.

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.