J'ai fais un code qui permet de lister dans un tableau html la liste de tous les dossiers dans C:/ sauf que j'ai besoin, juste du dossier et des 1er sous dossier :
ex: C:/Programme files/ Ponpon
C:/Programme files/ Panpan ... etc
je ne sais pas quoi modifier... et comment... (novice ^^)
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><h3><td><strong>Chemin des Dossiers :</strong></td></h3>" &_
"<td><strong>Autorisation </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 href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</a></td></tr>") 'Ecrire le path dans les lignes du Tableau en HTML
ListerDossier ObjSubRepItem.Path, Fichier 'traiter les sous-dossiers
Fichier.WriteLine ObjSubFileItem.Path 'Ecrire le path dans la liste
Next
End Function