Discussion :

[Lexounet]

Bonjour,

voilà mon premier post étant donner que je ne trouve pas de solution :
je cherche un script vbs permettant un listing de dossier et sous dossier et cela dans une page html.

j'ai le C:/ dont j'aimerai faire afficher dans un page html son contenue.

sachant que dans mon C:/ figure X sous dossier ex:

repertoire : C:/
sous repertoire :
Programmes Files
....

et dans ces sous repertoire figure également des repertoires que je ne veux pas afficher

le but de la création voulu de cette liste en forma html dans un tableau ou quelque chose dans ce style là

en vous remerciant du temps consacrer et de votre aide

Alexis D

[Lexounet]

J'ai réussi a faire un petit truc, comme ca, mais ce n'est pas ce que je veux... il me manque les dossiers d'aprés, et ce n'est pas en html bien sur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Chemin = "C:\"
 
Set SHW = Wscript.CreateObject(_
"shell.application")
 
Set oFolder = SHW.NameSpace(Chemin)
Set oFolderItems = oFolder.Items()
Msg = "Sous dossiers de " & Chemin
Msg = Msg & VbCrLf & _
" "
For each oFolderItem in oFolderItems
If oFolderItem.IsFolder Then
Msg = Msg & VBCRLF & _
oFolderItem.Name 
End If
Next
 
Msg = Msg & VbCrLf & " "
 
Msgbox Msg

[hackoofr]

J'ai réussi a faire un petit truc, comme ca, mais ce n'est pas ce que je veux... il me manque les dossiers d'aprés, et ce n'est pas en html bien sur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Chemin = "C:\"
 
Set SHW = Wscript.CreateObject(_
"shell.application")
 
Set oFolder = SHW.NameSpace(Chemin)
Set oFolderItems = oFolder.Items()
Msg = "Sous dossiers de " & Chemin
Msg = Msg & VbCrLf & _
" "
For each oFolderItem in oFolderItems
If oFolderItem.IsFolder Then
Msg = Msg & VBCRLF & _
oFolderItem.Name 
End If
Next
 
Msg = Msg & VbCrLf & " "
 
Msgbox Msg

Voila inspire-toi de cette discussion peut-être ça va t'aider à avancer un peu dans ton Projet Final.

[Lexounet]

Tout d'abbord Merci de ton aide...

En effet je suis admiratif de ton travail, mais je suis loin de ton niveau, a part être impressionné de ton travail, cela m'aide oui et non, je n'arrive pas a la transposer dans mon code je ne sais pas ce qui est utile ou pas...


Merci d'avance pour l'aide que vous pourriez m'apporter en plus.


Alexis D

[Lexounet]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
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.htm", 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
        Fichier.WriteLine ObjSubFileItem.Path 'Ecrire le path dans la liste
    Next
End Function

Là avec tous ce que j'ai trouvé plus l'aide de mon Boss je m'en approche grandement, je liste TOUS les fichier de C et je l'est met dans un fichier HTML, je voudrais faire la même chose sauf que dans un html ca soit a la ligne et pas tt collé, et me limité a dossier + ss dossier...

Merci a TOUS

[hackoofr]

Là avec tous ce que j'ai trouvé plus l'aide de mon Boss je m'en approche grandement, je liste TOUS les fichier de C et je l'est met dans un fichier HTML, je voudrais faire la même chose sauf que dans un html ca soit a la ligne et pas tt collé, et me limité a dossier + ss dossier...
Merci a TOUS

pour résoudre le problème de saut de la ligne il faut juste ajouter une balise <br> et le code devient alors comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
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.htm", 1, True)
'Ecrire la premiere ligne de la liste avec un saut de ligne en HTML
        Fichier.WriteLine (Schemin & "<br>")
'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 ("<br><a href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</a><br>") 'Ecrire le path dans la liste avec saut de ligne en HTML
        ListerDossier ObjSubRepItem.Path, Fichier 'traiter les sous-dossiers
        Fichier.WriteLine ObjSubFileItem.Path 'Ecrire le path dans la liste
    Next
End Function

[Lexounet]

Parfait, j'avais trouvé mais d'une autre manière ensuite comme je veux le présenter dans un tableau j'ai essayé plusieur technique mais elle ne marche pas ( soit pas de tableau; soit le c:/ au dessus )

MA SOLUTION :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
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) 
 
strTableau = "<html><TABLE BORDER='1' width='100%'><center><b><CAPTION><h2>Liste de sous dossier</h2></CAPTION></b></center><TR><TH> Chemin </TH></TR></TABLE></html>"
 
'Écrire la premiere ligne de la liste
        Fichier.WriteLine (Schemin & "<br>")
'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 ("<br><a href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</a><br>") 'Ecrire le path dans la liste avec saut de ligne en HTML
        ListerDossier ObjSubRepItem.Path, Fichier 'traiter les sous-dossiers
        Fichier.WriteLine ObjSubFileItem.Path 'Ecrire le path dans la liste
    Next
End Function

MA question ou mettre le code html pour qu'il soit au début de la page le tableau MERCI a VOUS !!

[hackoofr]

essaye ce code et dis-moi ça donne quoi comme résultat pour toi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
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 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

[Lexounet]

Merci

Tu est le roi du vbs c'est exactement ça, bon la il me selectionne tous les sous dossier alors que je souhaiterais m'arreter à 2 si tu as une idée... (désolé j'abuse) sinon la réponse ma déja grandement aidé !!

Merci a toi

[Lexounet]

Je n'y arrive pas j'ai essayé avec une multitude de boucle mais je ne trouve pas la solution

[hackoofr]

je souhaiterais m'arreter à 2

J'ai pas bien saisi ta question
Si tu reformule ta question en la détaillant plus explicitement et quelles sont tes tentatives ?
Fais un copier / coller de tes sources

[Lexounet]

Alors voila mon entreprise veux que dans un tableau html (comme tu ma aidé tout a l'heure) il y ai la liste des dossier + 1er sous dossier de C:/

Donc C:/
C:/programme files
C:/Programme files/blabla
C:/tata
C:/tata/bibi
...
etc mais pas plus loin comme je le fais actuellement...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
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>" &_
			  "<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

j'ai donc essayé en début de programme de me mettre une boucle pour qu'il s'arrete de lister a 2 / 3 fois mais je n'y arrive pas soit il me fait rien soit juste les 1er dossier de C:/
Merci a toi

[hackoofr]

Voila ce script va lister juste les dossiers sous C:\
mais si j'ai bien compris tu veux avancer en boucle en profondeur de 2 dossiers c'est ça ? que tu veux ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
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
Next
ListerDossier ObjSubRepItem.Path, Fichier 'traiter les sous-dossiers
Fichier.WriteLine ObjSubFileItem.Path 'Ecrire le path dans la liste
End Function

[Lexounet]

Ouai, c'est tout à fais ça avec les sous dossiers d'aprés...
Et si tu pouvais me mettre un commentaire pour savoir ce qu'il faut que je modifie si je veux allez encore plus en profondeur mais sinon oui c'est ça que je veux avec les sous dossier de ceux déja affiché...


Merci ENORMEMENT !!

[hackoofr]

Ouai, c'est tout à fais ça avec les sous dossiers d'aprés...
Et si tu pouvais me mettre un commentaire pour savoir ce qu'il faut que je modifie si je veux allez encore plus en profondeur mais sinon oui c'est ça que je veux avec les sous dossier de ceux déja affiché...
Merci ENORMEMENT !!

Voila essaye ce code avec "une profondeur de 2 Dossiers" et si tu veux aller plus en profondeur alors la "faites Attention de ne pas se noyer" et je te laisse réfléchir et casser un peu la tête et tu va le faire tout seul maintenant et n'oublies pas de le partager avec la communauté

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
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

[Lexounet]

Ca, marche, & j'ai compris c'est donc parfait trés bon prof



!!! RESOLU !!!

[pitchalov]

Salut.

J'ai pensé à une autre méthode pour choisir le nombre de sous niveaux visités par le script, en me basant sur le code de hackoofr (celui en mode récursif).
Le principe est simple : un niveu de sous-level max est définit en constante au début du script, et la fonction récursive ne dépasse pas ce niveau.
Cela permet de passer à un niveau 3, 4, etc sans avoir à recréer autant de variable dans la fonction de listing.

Voilà pour vous, juste au cas où :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Const INT_MAX_LEVEL = 2
 
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, 0 '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, intLevel) '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
	If intLevel < INT_MAX_LEVEL Then ListerDossier ObjSubRepItem.Path, Fichier, intLevel + 1 'traiter les sous-dossiers
	Fichier.WriteLine ObjSubFileItem.Path 'Ecrire le path dans la liste
	Next
End Function

[hackoofr]

Salut.
J'ai pensé à une autre méthode pour choisir le nombre de sous niveaux visités par le script, en me basant sur le code de hackoofr (celui en mode récursif).
Le principe est simple : un niveu de sous-level max est définit en constante au début du script, et la fonction récursive ne dépasse pas ce niveau.
Cela permet de passer à un niveau 3, 4, etc sans avoir à recréer autant de variable dans la fonction de listing.

Voilà pour vous, juste au cas où :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Const INT_MAX_LEVEL = 2
 
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, 0 '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, intLevel) '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
	If intLevel < INT_MAX_LEVEL Then ListerDossier ObjSubRepItem.Path, Fichier, intLevel + 1 'traiter les sous-dossiers
	Fichier.WriteLine ObjSubFileItem.Path 'Ecrire le path dans la liste
	Next
End Function

pitchalov
Effectivement ta méthode est plus astucieuse et plus facile à manipuler et à gérer dans ce genre de problème d'avoir partager cette idée