Lister l'arborescence d'un répertoire (sous-dossier,fichiers)

Contenu du snippet

Cette source liste tous les sous-dossiers et les fichiers d'un répertoire et liste le contenu des sous-dossiers, ainsi de suite... dans un fichier texte créer sur le bureau.

Le code est fonctionnel sous win XP, je ne l'ai pas tester sur d'autre.
Prêt à être utilisé en Vbscript, VBA ...

Le code est documenté et je vous laisse découvrir les possibilités de se traitement.

Il existe déjà en exemple avec la commande Dir, mais ne fonctionne pas sous vbscript.

Source / Exemple :


Dim ShellO: Set ShellO = CreateObject("WScript.Shell")
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim SListe: Dim Schemin
'Dossier à traiter
    Schemin = "C:\" 'Dossier à modifier
'Dossier Bureau de windows + "\"
    SListe = ShellO.SpecialFolders("Desktop")
    If Right(SListe, 1) <> "\" Then SListe = SListe & "\"
'Ouverture du fichier contenant l'arborescence du répertoire à traiter vers le Bureau
    Dim Fichier: Set Fichier = FSO.CreateTextFile(SListe & "Liste.txt", 1, True)
'Écrire la premiere ligne de la liste
        Fichier.WriteLine (Schemin)
'Lister l'arborescence du dossier
        ListerDossier Schemin, Fichier
'Fermeture du fichier contenant l'arborescence du répertoire à traiter
    Fichier.Close

Function ListerDossier(Schemin, Fichier) 'Lister l'arborescence du dossier
On Error Resume Next
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim ObjRep: Set ObjRep = FSO.GetFolder(Schemin) 'dossier
Dim ObjSubRep: Set ObjSubRep = ObjRep.SubFolders 'sous-dossiers
Dim ObjSubRepItem
    For Each ObjSubRepItem In ObjSubRep 'Traiter chaque sous-dossiers
        Fichier.WriteLine (ObjSubRepItem.Path) 'Ecrire le path dans la liste
        ListerDossier ObjSubRepItem.Path, Fichier 'traiter les sous-dossiers
    Next
    Dim ObjRepFind: Set ObjRepFind = FSO.GetFolder(Schemin) 'dossier
    Dim ObjSubFile: Set ObjSubFile = ObjRepFind.Files 'Fichiers
    Dim ObjSubFileItem
    For Each ObjSubFileItem In ObjSubFile 'Traiter chaque fichier du répertoire
        Fichier.WriteLine ObjSubFileItem.Path 'Ecrire le path dans la liste
    Next
End Function

A voir également