Script, Dossier + Sous Dossier + "publication" page HTML

Version imprimable

16/05/2011, 16h11
Lexounet

Script, Dossier + Sous Dossier + "publication" page HTML

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

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:

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

Citation:
Envoyé par 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:

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
:salut:
Voila inspire-toi de cette discussion peut-être ça va t'aider à avancer un peu dans ton Projet Final.

17/05/2011, 09h16
Lexounet

Tout d'abbord Merci de ton aide...:ccool:

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

Code:

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 :ccool:

Citation:

Envoyé par Lexounet

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 :ccool:

:salut:
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:

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

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:

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 !!

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

Code:

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

18/05/2011, 08h43
Lexounet

Merci :ccool::mrgreen:

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 :ccool:
18/05/2011, 10h16
Lexounet

Je n'y arrive pas j'ai essayé avec une multitude de boucle mais je ne trouve pas la solution :cry:
18/05/2011, 11h27
hackoofr

Citation:

Envoyé par Lexounet

je souhaiterais m'arreter à 2

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

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:

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

:salut: 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:

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

18/05/2011, 12h02
Lexounet

:salut:

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 !! :P

Citation:

Envoyé par Lexounet

:salut:
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 !! :P

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

Code:

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

19/05/2011, 08h37
Lexounet

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

:ccool::ccool:

!!! RESOLU !!!

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:

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

Citation:

Envoyé par 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:

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

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