Script simple, pour lister les dossiers et 1er sous dossier d'un répertoire...
Evolutif on peut allez de plus en plus en profondeur...
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.html", 1, True)
strHTML=strHTML &"<center><h2><B><font color=red>Liste des Dossiers et Sous-Dossiers dans C:\ </font></B></h2></center>" & _
"<table border='3' cellpadding='10' style='border-collapse: collapse; font size:11pt' bordercolor='#CCCCCC' width='100%' id='Table1'>" & _
"<tr><td><strong>Chemin des Dossiers :</strong></td></tr>"
'Fichier.WriteLine (Schemin & "<br>")
Fichier.WriteLine strHTML 'Ecrire la structure du Tableau en HTML
ListerDossier Schemin, Fichier 'Remplissage dynamique des données dans le Tableau
Fichier.WriteLine "</table>" 'ici on ferme notre tableau par la balise </table>
'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 ("<tr><td><a target=_Blank href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</a></td></tr>") 'Ecrire le path dans les lignes du Tableau en HTML
For each objsubfolder2 in ObjSubRepItem.subfolders
Fichier.WriteLine ("<tr><td><a target=_Blank href='" & ObjSubfolder2.Path & "'>" & ObjSubfolder2.Path & "</a></td></tr>") 'Ecrire le path avec profondeur de 2 Dossiers
Next
Next
End Function
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.