VBA - Excel

Bonjour Rodavaflo & Co

Voici un programme VBA qui liste tous les sous_repertoires d'un repertoire "c:\...\utilisateur" dans une ListBox. Je l'ai dérivé d'une discussion en cours sur ce forum et traitant, à peu de choses près, du même sujet.

Sub lister_repertoires_utilisateur()
    Dim liste As String, ligne As Integer, chemin As String
    Dim userDir As String
    userDir = "c:\...\utilisateur"   ' à modifier
    recurseListeSousRep userDir, liste
    ligne = 1
    Do
        chemin = Left(liste, InStr(1, liste, ";"))
        liste = Replace(liste, chemin, "", 1, 1)
        chemin = Replace(chemin, userDir & "\", "", 1, 1)
        Cells(ligne, 1).Value = Replace(chemin, ";", "", 1)
        ligne = ligne + 1
    Loop Until liste = ""
    ListBox.RowSource = "A1:A" & Trim(Str(ligne - 1))
End Sub

Sub recurseListeSousRep(rep As String, liste As String)
'
' liste récursivement les sous-repertoires du repertoire rep
'
    Dim fileSys             ' objet representant le systeme de fichiers
    Dim repertoireCourant   ' objet Folder representant le repertoire courant
    Dim sousRepertoires     ' objet Folders representant les sous-repertoires
    Dim sousRepertoire      ' objet Folder representant l'un des sous-repertoires
    Dim sep As String       ' separateur ("\" pour Windows)
    Dim cible As String     ' chemin du fichier dans le repertoire courant
    Dim Erreur As Boolean
'    MsgBox liste
    sep = Application.PathSeparator
    Set fileSys = CreateObject("Scripting.fileSystemObject")
' creer un objet Folder representant le repertoire courant
    Set repertoireCourant = fileSys.getfolder(rep)
' creer une collection Folders representant les sous-repertoires
    Set sousRepertoires = repertoireCourant.subfolders
' balayer la collection en creant un objet Folder pour chaque sous-repertoire
    On Error GoTo erreurAccesRep
    Erreur = False
    For Each sousRepertoire In sousRepertoires
' recherche le fichier par iteration
        If Not Erreur Then
            liste = liste & rep & sep & sousRepertoire.Name & ";"
            recurseListeSousRep rep & sep & sousRepertoire.Name, liste
        End If
    Next
    On Error GoTo 0
    Exit Sub
erreurAccesRep:
    Erreur = True
    Resume Next
End Sub

Cordialement