[VBs] Liste de dossiers et sous dossiers

Version imprimable

Bonsoir à tous,

Je suis à la recherche un script en vbs qui pourrait faire une liste des dossiers et des sous dossier d'un dossier particulier.

Je m'explique : j'ai ce dossier "D:\mes documents\mes documents\script" et je veux savoir ce qu'il y a dedans.

Pour ca j'ai commencé a faire
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 Const outFile = "file.html" path = "D:\mes documents\mes documents\script" Dim oFilesys Set oFilesys = CreateObject("Scripting.FileSystemObject") Set oFiletxt = oFilesys.CreateTextFile(outFile, True) 'Get script path oFiletxt.WriteLine( "<html> <body>") oFiletxt.WriteLine( path & "<br/>") oFiletxt.WriteLine(List(path)) oFiletxt.WriteLine("</body></hmtl>") oFiletxt.Close Wscript.echo " End of script." Function List(directory) Set fsoFolder = CreateObject("Scripting.FileSystemObject") Set folder = fsoFolder.GetFolder(directory) Set subfolders = folder.SubFolders Set subfiles = folder.Files for each objFolder in subfolders oFiletxt.WriteLine(" |+ " & objFolder.Name & "<br/>") next for each objFile in subfiles oFiletxt.WriteLine(" <dd>|- " & objFile.Name & "<br/>") next End Function
sauf qu'une fois que j'ai lu un sous dossier, j'obtiens ce ci
Code:

1 2 3 4 5 6 7 8 D:\mes documents\mes documents\script |+ Nouveau dossier |- Copie de liste_trsf.vbs |- file.html |- liste_dossier.vbs |- liste_docu.vbs |- file.docx
sauf que je devrais avoir une chose du genre
Code:

1 2 3 4 5 6 7 8 D:\mes documents\mes documents\script |+ Nouveau dossier |- Copie de liste_trsf.vbs |- file.html |- liste_dossier.vbs |- liste_docu.vbs |- file.docx
je pense que je me suis planté sur l'affichage et dans mes conditions de boucles, je ne suis pas un spécialiste :s

Merci à tous,
doc'

:salut:
Juste il te manque un appel récursive dans la même fonction List(objFolder) ;)
Dans la :faq: il y a un exemple : Comment agir sur tous les fichiers d'un répertoire ?
Donc ton script devient :

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
Const outFile = "file.html"
path = "D:\mes documents\mes documents\script"
 
Dim oFilesys
Set oFilesys = CreateObject("Scripting.FileSystemObject")
Set oFiletxt = oFilesys.CreateTextFile(outFile,True)
Set Ws = CreateObject("Wscript.Shell")
 
oFiletxt.WriteLine("<html> <body>")
oFiletxt.WriteLine(path & "<br/>")
oFiletxt.WriteLine(List(path))
oFiletxt.WriteLine("</body></hmtl>")
oFiletxt.Close
 
MsgBox "Script Terminé !",64,"Générer Arborescence de dossier et sous-dossiers en HTML"
Ws.Run outFile
 
Function List(directory)
    Set fsoFolder = CreateObject("Scripting.FileSystemObject")
    Set folder = fsoFolder.GetFolder(directory)
    Set subfolders = folder.SubFolders
    Set subfiles = folder.Files
 
    for each objFolder in subfolders
        oFiletxt.WriteLine(" |+ " & objFolder.Name & "<br/>")
        List(objFolder) 'Appel récusive de la fonction List
    next    
 
    for each objFile in subfiles
        oFiletxt.WriteLine(" <dd>|- " & objFile.Name & "<br/>")
    next
 End Function

Bonjour,

Merci pour l'aide. J'ai essayé de retravailler le script car il n'affiche pas du tout les bon fichier dans le bon dossier, un peu genant ^^"

voila pour le moment ce que j'ai essayé de faire, ça me parait pas trop mal, sauf que ca correspond pas du tout a mon arborescence test

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
38
39
40
41
42
43
 
Const outFile = "file.html"
path = "D:\mes documents\mes documents\script"
 
Dim oFilesys
Set oFilesys = CreateObject("Scripting.FileSystemObject")
Set oFiletxt = oFilesys.CreateTextFile(outFile, True)
 
'Get script path
 
oFiletxt.WriteLine( "<html> <body>")
oFiletxt.WriteLine( path & "<br/>")
oFiletxt.WriteLine(List(path))
oFiletxt.WriteLine("</body></hmtl>")
oFiletxt.Close
 
Wscript.echo " End of script."
 
Function List(directory)
	Set fsoFolder = CreateObject("Scripting.FileSystemObject")
	Set folder = fsoFolder.GetFolder(directory)
	Set subfolders = folder.SubFolders
	Set subfiles = folder.Files
 
 
 
		for each objFolder in subfolders
			oFiletxt.WriteLine(" |+ " & objFolder.Name & "<br/>")
 
			if fsoFolder.FolderExists(path) then
				for each objFile in subfiles
				oFiletxt.WriteLine(" <dd>|- " & objFile.Name & "<br/>")
 
				next
			end if
		List(objFolder) 'Appel récusive de la fonction List	
		next	
 
'insertion commentaire
oFile.WriteLine  (" <!-- liste directement dans le fichier -->")
 
 
End Function

voila le resultat

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
<html> <body>
D:\mes documents\mes documents\script<br/>
 |+ Nouveau dossier<br/>
 <dd>|- Copie de liste_film_dd_trsf.vbs<br/>
 <dd>|- file.html<br/>
 <dd>|- file2.html<br/>
 <dd>|- liste_dossier.vbs<br/>
 <dd>|- liste_film.vbs<br/>
 <dd>|- liste_film_dd_trsf.vbs<br/>
 |+ Nouveau dossier<br/>
 <dd>|- file.txt<br/>
 <!-- liste directement dans le fichier -->
 <!-- liste directement dans le fichier -->
 <!-- liste directement dans le fichier -->
</body></hmtl>

il devrait être celui ci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
<html> <body>
D:\mes documents\mes documents\script<br/>
 |+ Nouveau dossier<br/>
  <dd> |+ Nouveau dossier<br/>
 <dd><dd>|- file.txt<br/>
<!-- liste directement dans le fichier -->
 <dd>|- Copie de liste_film_dd_trsf.vbs<br/>
 <dd>|- file.html<br/>
 <dd>|- file2.html<br/>
 <dd>|- liste_dossier.vbs<br/>
 <dd>|- liste_film.vbs<br/>
 <dd>|- liste_film_dd_trsf.vbs<br/>
</body></hmtl>

je travaille encore dessus grâce a la fac et a quelques script trouvé ici et la

cordialement

edit : je viens de faire ce code plus simple

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
38
39
40
41
42
43
44
 
Const outFile = "file.html"
path = "D:\mes documents\mes documents\script"
 
Dim oFilesys
Set oFilesys = CreateObject("Scripting.FileSystemObject")
Set oFiletxt = oFilesys.CreateTextFile(outFile, True)
 
'Get script path
 
oFiletxt.WriteLine( "<html> <body>")
oFiletxt.WriteLine( path & "<br/>")
oFiletxt.WriteLine(List(path))
oFiletxt.WriteLine("</body></hmtl>")
oFiletxt.Close
 
Wscript.echo " End of script."
 
Function List(directory)
	Set fsoFolder = CreateObject("Scripting.FileSystemObject")
	Set folder = fsoFolder.GetFolder(directory)
	Set subfolders = folder.SubFolders
	Set subfiles = folder.Files
 
 
 
		if fsoFolder.FolderExists(path) then
 
			for each objFile in folder.Files
			oFiletxt.WriteLine(" |- " & objfile.Name & "<br/>")
			next
		end if
 
	for each objFolder in subfolders
		oFiletxt.WriteLine(" <!-- sous dossier-->")
		oFiletxt.WriteLine(" |+ " & objFolder.Name & "<br/>")
		for each objFile in objFolder.Files
			oFiletxt.WriteLine(" |-- " & objFile.Name & "<br/>")
		next
	List(objFolder)
 
	next
 
End Function

par contre j'ai un fichier qui se trimballe a la fin que j'arrive pas a enlever

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
<html> <body>
D:\mes documents\mes documents\script<br/>
 |- Copie de liste_film_dd_trsf.vbs<br/>
 |- file.html<br/>
 |- file2.html<br/>
 |- file_test.html<br/>
 |- liste_dossier.vbs<br/>
 |- liste_film.vbs<br/>
 |- liste_film_dd_trsf.vbs<br/>
 <!-- sous dossier-->
 |+ ss1<br/>
 |-- file.txt<br/>
 |- file.txt<br/><<<<=== ce fichier a virer deja present

 <!-- sous dossier-->
 |+ ss2<br/>
 |-- teste.txt<br/>
 |- teste.txt<br/> <<<<=== ce fichier a virer deja present

</body></hmtl>

:salut:
Testez ce :

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
38
39
40
Const outFile = "file.html"
Path = "C:\Program Files"
 
Dim oFilesys
Set oFilesys = CreateObject("Scripting.FileSystemObject")
Set oFiletxt = oFilesys.CreateTextFile(outFile,True)
Set Ws = CreateObject("Wscript.Shell")
 
oFiletxt.WriteLine("<html><body text=white bgcolor=#1234568><style type='text/css'>"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>")
 
oFiletxt.WriteLine("<a target=_Blank href='file:///" & Path & "'>" & Path & "</a><br/>")
oFiletxt.WriteLine(List(path))
oFiletxt.WriteLine("</body></hmtl>")
oFiletxt.Close
 
MsgBox "Script Terminé !",64,"Générer Arborescence de dossier et sous-dossiers en HTML"
Ws.Run outFile
 
Function List(directory)
On Error Resume next
    Set fsoFolder = CreateObject("Scripting.FileSystemObject")
    Set folder = fsoFolder.GetFolder(directory)
    Set subfolders = folder.SubFolders
    Set subfiles = folder.Files
 
    For each objFile in subfiles
        oFiletxt.WriteLine(" <dd>|- <a target=_Blank href='file:///" & objFile.Path & "'>" & objFile.Name & "</a><br/>")
    Next
 
    For each objFolder in subfolders
        oFiletxt.WriteLine(" |+  <a target=_Blank href='file:///" & objFolder.Path & "'>" & objFolder.Name & "</a><br/>")
        oFiletxt.WriteLine("Liste des fichiers dans le Dossier "& objFolder.Name &"</br>")
        List(objFolder) 'Appel récusive de la fonction List
    Next    
End Function

16/09/2013, 20h12
docofchaos

bonsoir,

heu que dire, 8O
Bravo, c'est plus que ce que j'espérais, car je voulais faire également un href du dossier.

je vais décortiquer le code pour le comprendre, car le script fait tous ce que je voulais mettre en oeuvre :ccool:

Merci énormément je n'en espérais pas tant

:salut:
Testez cette version : ça devient une Source pas un code :mouarf: :king:

- Ajout BrowseForFolder pour parcourir le dossier à choisir.
- Ajout des icônes de dossiers et de fichiers.
- Ajout nombre de fichiers.
- Ajout taille de dossiers et de fichiers.

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
Option Explicit
Const outFile = "file.html"
Dim oFilesys,oFiletxt,Path,Ws,SourceImgFolder,StartTime,MsgTitre,DurationTime,objFolder,CheminDossier,Dossier,Copyright
Dim SizeKo,SizeMo,SizeGo,objShell,fso,size
Copyright = "© Hackoo © 2013"
MsgTitre = "Générer une arborescence d'un dossier en HTML "&Copyright&""
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier "&Copyright, 1, "c:\Programs")
If objFolder Is Nothing Then
        WScript.Quit
End If
CheminDossier = objFolder.self.path
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(CheminDossier)
If Dossier.Size = 0 Then
        MsgBox "Le Dossier " & CheminDossier & " est vide",16,"Dossier Vide"
        WScript.Quit
End if
    SizeKo = Round(FormatNumber(Dossier.Size)/(1024),1) & " Ko" 'Taille en Ko avec 1 chiffre après la Virgule
    SizeMo = Round(FormatNumber(Dossier.Size)/(1048576),1) & " Mo" 'Taille en Mo avec 1 chiffre après la Virgule
    SizeGo = Round(FormatNumber(Dossier.Size)/(1073741824),1) & " Go" 'Taille en Go avec 1 chiffre après la Virgule
 
	If Dossier.size < 1024 Then 
	   Size = Dossier.size & " Octets"
	elseif Dossier.size < 1048576 Then 
	   Size = SizeKo
	elseif Dossier.size < 1073741824 Then 
	   Size = SizeMo
	else
	   Size = SizeGo
	end If
Set oFilesys = CreateObject("Scripting.FileSystemObject")
Set oFiletxt = oFilesys.CreateTextFile(outFile,True)
Set Ws = CreateObject("Wscript.Shell")
 
oFiletxt.WriteLine("<html><body text=white bgcolor=#1234568><style type='text/css'>"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>")
SourceImgFolder = "http://upload.wikimedia.org/wikipedia/commons/a/a4/Icons-mini-folder.gif"
StartTime = Timer 'Début du Compteur Timer
oFiletxt.WriteLine("+ <img src="&SourceImgFolder&">  <a target=_Blank href='file:///" & CheminDossier & "'>" & CheminDossier & "</a><font color=""Yellow"">&nbsp;&nbsp;["&Size&"]</font><br><br>")
oFiletxt.WriteLine(List(CheminDossier))
oFiletxt.WriteLine("</body></hmtl>")
oFiletxt.Close
DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds." 'La durée de l'exécution du script
Ws.Popup "La génération au format HTML est terminée dans "& DurationTime & " !","5",MsgTitre,64
Ws.Run outFile
 
Function List(directory)
Dim fsoFolder,Folder,subfolders,objFile,objFolder,subfiles,SourceImgFile,NBFiles,Size,SizeKo,SizeMo,SizeGo,SourceImgFolder
On Error Resume next
    Set fsoFolder = CreateObject("Scripting.FileSystemObject")
    Set folder = fsoFolder.GetFolder(directory)
    Set subfolders = folder.SubFolders
    Set subfiles = folder.Files
    SourceImgFolder = "http://upload.wikimedia.org/wikipedia/commons/a/a4/Icons-mini-folder.gif"
    SourceImgFile = "http://upload.wikimedia.org/wikipedia/en/d/d8/VBSccript_file_format_icon.png"
    NBFiles = 0
    For each objFile in subfiles
    NBFiles = NBFiles + 1
    SizeKo = Round(FormatNumber(objFile.Size)/(1024),1) & " Ko" 'Taille en Ko avec 1 chiffre après la Virgule
    SizeMo = Round(FormatNumber(objFile.Size)/(1048576),1) & " Mo" 'Taille en Mo avec 1 chiffre après la Virgule
    SizeGo = Round(FormatNumber(objFile.Size)/(1073741824),1) & " Go" 'Taille en Go avec 1 chiffre après la Virgule
 
	If objFile.size < 1024 Then 
	   Size = objFile.size & " Octets"
	elseif objFile.size < 1048576 Then 
	   Size = SizeKo
	elseif objFile.size < 1073741824 Then 
	   Size = SizeMo
	else
	   Size = SizeGo
	end If
 
        oFiletxt.WriteLine("<dd>"& NBFiles &" |-<img src="&SourceImgFile&" height=""18"" width=""20"">  <a target=_Blank href='file:///" & objFile.Path & "'>" & objFile.Name & "</a>&nbsp;&nbsp;("&Size&")<br/>")
    Next
 
    For each objFolder in subfolders
         SizeKo = Round(FormatNumber(objFolder.Size)/(1024),1) & " Ko" 'Taille en Ko avec 1 chiffre après la Virgule
         SizeMo = Round(FormatNumber(objFolder.Size)/(1048576),1) & " Mo" 'Taille en Mo avec 1 chiffre après la Virgule
         SizeGo = Round(FormatNumber(objFolder.Size)/(1073741824),1) & " Go" 'Taille en Go avec 1 chiffre après la Virgule
 
     If objFolder.size < 1024 Then 
			Size = objFolder.size & " Octets"
     elseif objFolder.size < 1048576 Then 
         Size = SizeKo
     elseif objFolder.size < 1073741824 Then 
        Size = SizeMo
     else
        Size = SizeGo
     end If
 
        oFiletxt.WriteLine("<br><DL>+ <img src="&SourceImgFolder&">  <a target=_Blank href='file:///" & objFolder.Path & "'>" & objFolder.Path & "</a>&nbsp;&nbsp;<font color=""Yellow"">["&Size&"]</font><br><br/>")
        List(objFolder) 'Appel récusive de la fonction List
    Next    
End Function

Bonjour,

Si je peux me permettre une légère optimisation du script :
- Appel une seule fois de "size" par objet file ou folder
- Fermeture des listes html avec la balise "</dl>" après l'appel de la fonction récursive

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Option Explicit
 
Const outFile = "file.html"
 
Dim oFiletxt,Path,Ws,SourceImgFolder,StartTime,MsgTitre,DurationTime,objFolder,CheminDossier,Dossier,Copyright
Dim intSize,objShell,fso,strSize
Copyright = "© Hackoo © 2013"
 
MsgTitre = "Générer une arborescence d'un dossier en HTML "&Copyright&""
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier "&Copyright, 1, "c:\Programs")
If objFolder Is Nothing Then WScript.Quit
 
CheminDossier = objFolder.self.path
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(CheminDossier)
intSize = Dossier.Size
If intSize = 0 Then
	MsgBox "Le Dossier " & CheminDossier & " est vide",16,"Dossier Vide"
	WScript.Quit
End if
 
intSize = Round(FormatNumber(intSize)/(1024),2)
If intSize < 1024 Then 
	strSize = intSize & " Ko"
elseif intSize < 1048576 Then 
	strSize = Round(FormatNumber(intSize)/(1024),2)& " Mo"
else
	strSize = Round(FormatNumber(intSize)/(1073741824),2) & " Go"
end If
 
Set oFiletxt = fso.CreateTextFile(outFile,True)
Set Ws = CreateObject("Wscript.Shell")
 
oFiletxt.WriteLine("<html><body text=white bgcolor=#1234568><style type='text/css'>"&_
	"a:link {color: #F19105;}"&_
	"a:visited {color: #F19105;}"&_
	"a:active {color: #F19105;}"&_
	"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
	"</style>")
 
SourceImgFolder = "http://upload.wikimedia.org/wikipedia/commons/a/a4/Icons-mini-folder.gif"
 
StartTime = Timer 'Début du Compteur Timer
oFiletxt.WriteLine "+ <img src="&SourceImgFolder&">  <a target=_Blank href='file:///" & _
	CheminDossier & "'>" & CheminDossier & "</a><font color=""Yellow"">&nbsp;&nbsp;["&strSize&"]</font><br><br>" & _
	List(CheminDossier) & "</body></hmtl>"
oFiletxt.Close
 
DurationTime = FormatNumber(Timer - StartTime, 0) & " secondes." 'La durée de l'exécution du script
Ws.Popup "La génération au format HTML est terminée en "& DurationTime & " !","5",MsgTitre,64
Ws.Run outFile
 
Function List(directory)
	Dim objFso,objRootFolder,subfolders,objFile,objFolder,subfiles,SourceImgFile,NBFiles,intSize,strSize,SourceImgFolder
	On Error Resume next
	Set objFso = CreateObject("Scripting.FileSystemObject")
	Set objRootFolder = objFso.GetFolder(directory)
	Set subfolders = objRootFolder.SubFolders
	Set subfiles = objRootFolder.Files
	SourceImgFolder = "http://upload.wikimedia.org/wikipedia/commons/a/a4/Icons-mini-folder.gif"
	SourceImgFile = "http://upload.wikimedia.org/wikipedia/en/d/d8/VBSccript_file_format_icon.png"
	NBFiles = 0
	For each objFile in subfiles
		NBFiles = NBFiles + 1
		intSize = Round(FormatNumber(objFile.Size)/(1024),2)
		If intSize < 1024 Then 
			strSize = intSize & " Ko"
		elseif intSize < 1048576 Then 
			strSize = Round(FormatNumber(intSize)/(1024),2)& " Mo"
		else
			strSize = Round(FormatNumber(intSize)/(1073741824),2) & " Go"
		end If
		oFiletxt.WriteLine("<dd>"& NBFiles &" |-<img src="&SourceImgFile&" height=""18"" width=""20"">  <a target=_Blank href='file:///" & objFile.Path & "'>" & objFile.Name & "</a>&nbsp;&nbsp;("&strSize&")<br/>")
	Next
 
	For each objFolder in subfolders
		intSize = Round(FormatNumber(objFolder.Size)/(1024),2)
		If intSize < 1024 Then 
			strSize = intSize & " Ko"
		elseif intSize < 1048576 Then 
			strSize = Round(FormatNumber(intSize)/(1024),2)& " Mo"
		else
			strSize = Round(FormatNumber(intSize)/(1073741824),2) & " Go"
		end If
		oFiletxt.WriteLine("<br><DL>+ <img src="&SourceImgFolder&">  <a target=_Blank href='file:///" & objFolder.Path & "'>" & objFolder.Path & "</a>&nbsp;&nbsp;<font color=""Yellow"">["&strSize&"]</font><br><br/>")
		List(objFolder) 'Appel récusive de la fonction List
		oFiletxt.WriteLine("</DL>")
	Next    
End Function

Bonne continuation

17/09/2013, 12h34
hackoofr

:merci: pitchalov d'avoir apporter vos grains de sel la dessus :king:
par contre, étant donné que c'est la 1ere fois que j'utilise ces balises <DD> et <DL>, alors je rencontre un petit problème dans l'affichage, c'est que le dossier parent apparaît en dernier :koi:
Avez-vous une solution pour remédier ceci.
et :merci: encore pour l’optimisation :ccool:

Bonjour,

L'appel de la procédure est fait au milieu de la création d'une chaine de caractères, d'où je pense un placement bizzare dans le résultat :aie:. Ce n'est pas une fonction mais une procédure, l'appel doit plutôt se faire comme ça :

Code:

1
2
3
4
oFiletxt.WriteLine "+ <img src="&SourceImgFolder&">  <a target=_Blank href='file:///" & _
	CheminDossier & "'>" & CheminDossier & "</a><font color=""Yellow"">&nbsp;&nbsp;["&strSize&"]</font><br><br>"
List(CheminDossier)
oFiletxt.WriteLine "</body></hmtl>"

Je m'y suis un peu penché et du coup voilà deux autres scripts permettant de parcourir des dossiers et créer un affichage en HTML. Ils permettent de définir le nombre d'arborescences à parcourir, et proposent des affichages différents :

- Un premier toujours avec DL, DT, DD (listes HTML) :

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
38
39
40
41
42
43
44
45
46
47
Option Explicit
 
Const strOutputFile = "file.html"
Const strFolderPath = "C:\"
Dim objOutputFile, objShell, objFso, timeStart, objFolder
 
Set objFso = CreateObject("Scripting.FileSystemObject")
If NOT objFso.FolderExists(strFolderPath) Then Wscript.Quit 100
 
Set objFolder = objFso.GetFolder(strFolderPath)
Set objOutputFile = objFso.CreateTextFile(strOutputFile,True)
objOutputFile.WriteLine("<html><body text=white bgcolor=#1234568><style type='text/css'>" & _
	"body {font-size:x-small}" & _
	"a:link {color: #F19105;}" & "a:visited {color: #F19105;}" & "a:active {color: #F19105;}" & _
	"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}" & "</style>")
 
timeStart = Timer
 
objOutputFile.WriteLine "<dl>"
BrowseFolder objFolder, 0, 4
objOutputFile.WriteLine "</dl>" & vbCrLf & _
	"<br /><h4>Génération en <" & FormatNumber(Timer - timeStart, 0) & "> secondes</h4>" & vbCrLf & _
	"</body></hmtl>"
objOutputFile.Close
 
WScript.Echo "END"
 
Sub BrowseFolder(objRootFolder, intCurrenLevel, intLevelMax)
	Dim objFso, colSubFolders, objFile, objSubFolder, colFiles, intNbFiles
	On Error Resume Next
	Set objFso = CreateObject("Scripting.FileSystemObject")
	Set colSubFolders = objRootFolder.subFolders
	Set colFiles = objRootFolder.Files
	If intCurrenLevel = 0 Then objOutputFile.WriteLine "<h3>"
	objOutputFile.WriteLine "<dt>+ <a target=_Blank href='file:///" & objRootFolder.Path & "'>" & objRootFolder.Path & "</a></dt>"
	If intCurrenLevel = 0 Then objOutputFile.WriteLine "</h3>"
	For Each objSubFolder in colSubFolders
		objOutputFile.WriteLine "<dl>"
		If intCurrenLevel <= intLevelMax Then BrowseFolder objSubFolder, intCurrenLevel + 1, intLevelMax
		objOutputFile.WriteLine "</dl>"
	Next
	intNbFiles = 0
	For Each objFile in colFiles
		intNbFiles = intNbFiles + 1
		objOutputFile.WriteLine "<dd>"& intNbFiles &" |- " & objFile.Name & "</dd>"
	Next
End Sub

Un second avec un affichage semblable à la commande "tree" des systèmes UNIX :

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
Option Explicit
 
Const STR_OUTPUT_HTML_FILE = "file.html"
Const STR_ROOT_FOLDER_PATH = "C:\"
Const INT_MAX_LEVELS = 3
 
Dim objOutputFile, objShell, objFso, timeStart, objFolder
 
Set objFso = CreateObject("Scripting.FileSystemObject")
If NOT objFso.FolderExists(STR_ROOT_FOLDER_PATH) Then Wscript.Quit 100
 
Set objFolder = objFso.GetFolder(STR_ROOT_FOLDER_PATH)
Set objOutputFile = objFso.CreateTextFile(STR_OUTPUT_HTML_FILE,True)
objOutputFile.WriteLine("<html><body text=white bgcolor=#1234568><style type='text/css'> " & _
	"body {font-size:small} a:link {color: #F19105;} a:visited {color: #F19105;}</style>")
 
timeStart = Timer
 
BrowseFolder objFolder, 0, INT_MAX_LEVELS, False
objOutputFile.WriteLine "<br /><h5>Génération en <" & FormatNumber(Timer - timeStart, 0) & "> secondes</h5>" & vbCrLf & "</body></hmtl>"
objOutputFile.Close
 
WScript.Echo "END"
 
Sub BrowseFolder(objRootFolder, intCurrenLevel, intLevelMax, boolLastFolder)
	Dim objFso, colSubFolders, objFile, objSubFolder, colFiles, intNbItems, intLastItem, boolLastItem
	On Error Resume Next
	Set objFso = CreateObject("Scripting.FileSystemObject")
	Set colSubFolders = objRootFolder.subFolders
	Set colFiles = objRootFolder.Files
 
	If intCurrenLevel = 0 Then objOutputFile.WriteLine "<h3>Root Folder : "
	objOutputFile.WriteLine IncrementTree(intCurrenLevel, boolLastFolder) & "<a target=_Blank href='file:///" & _
		objRootFolder.Path & "'>" & objRootFolder.Path & "</a><br />"
	If intCurrenLevel = 0 Then objOutputFile.WriteLine "</h3>"
 
	intNbItems = 0
	intLastItem = colSubFolders.Count
	boolLastItem = False
	For Each objSubFolder in colSubFolders
		intNbItems = intNbItems + 1
		If intNbItems = intLastItem Then boolLastItem = True
		If intCurrenLevel <= intLevelMax Then BrowseFolder objSubFolder, intCurrenLevel + 1, intLevelMax, boolLastItem
	Next
 
	intNbItems = 0
	intLastItem = colFiles.Count
	boolLastItem = False
	For Each objFile in colFiles
		intNbItems = intNbItems + 1
		If intNbItems = intLastItem Then boolLastItem = True
		objOutputFile.WriteLine IncrementTree(intCurrenLevel, boolLastItem) & objFile.Name & "<br />"
	Next
End Sub
 
Function RepeatString (strInputString, intNbIteration)
	Dim i
	RepeatString = ""
	i = 0
	Do While i < intNbIteration
		RepeatString = RepeatString  & strInputString
		i = i + 1
	Loop
End Function
 
Function IncrementTree (intNbIteration, boolLastItem)
	Dim strEol
	IncrementTree = ""
	If intNbIteration = 0 Then Exit Function
	strEol = "|--&nbsp;"
	If boolLastItem = True Then strEol = "`--&nbsp;"
	IncrementTree = RepeatString("|&nbsp;&nbsp;&nbsp;", intNbIteration - 1) & strEol
End Function

Si ça peut vous intéresser.

Bonne continuation

:salut:
En utilisant la commande Unix Tree (Juste affichage de l'arborescence sans liens):

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
38
39
40
41
42
DIM chi 
Titre = "Tree"
Chemin = InputBox("Taper le chemin du dossier, pour afficher son arborescence",Titre,"%Temp%")
Lecteur = Left(Chemin,2)
'msgbox Chemin
'msgbox Lecteur & "& cd \ & tree "& Chemin &" /a /f"
RunDos Lecteur & "& cd \ & tree " & Chemin &" /a /f",TempFile
 
Function RunDos(Command,TempFile)
Set ws = CreateObject("WScript.Shell")
Res = ws.run("cmd /c "&Command&" > "&TempFile,0,True)
    MsgBox Formater(TempFile)
    ws.Run TempFile
End Function
 
Function Formater(TempFile)
Set fso = CreateObject("Scripting.FileSystemObject")
Set F = fso.OpenTextFile(TempFile,1)
ReadMe = F.ReadAll
F.Close
Set fWrite = fso.OpenTextFile(TempFile,2,True)
Tab = split(ReadMe,vbcrlf)
    For i = lbound(Tab) to ubound(Tab)
        Text=Text & Tab(i) & "<br>" & vbcrlf
    Next
Text = Replace(Text,"‚","é")
Text = Replace(Text,"ÿ"," ")
Text = Replace(Text,"ˆ","ê")
Text = Replace(Text,"‡","ç")
Text = Replace(Text,"“","ô")
Text = Replace(Text,"…","à")
Text = Replace(Text,"Š","è")
Text = Replace(Text,"ƒ","â")
Text = Replace(Text,"ے"," ")
fWrite.WriteLine Text
Formater = Text
End Function
 
Function TempFile()
Set Ws = CreateObject("WScript.Shell")
TempFile = Ws.ExpandEnvironmentStrings("%TEMP%")&"\out.html"
End Function

29/12/2013, 19h39
hackoofr

:salut:
Juste si vous voulez aller plus loin ; Alors, vous pouvez le faire aussi en Autoit : Dir2HTML
02/01/2014, 13h45
ABOAT

Bonjour
Ou est le meileure code ?
Merci ^^
02/01/2014, 19h39
hackoofr

Citation:

Envoyé par ABOAT

Bonjour
Ou est le meilleure code ?
Merci ^^

:salut:
ça dépend ce que vous voulez faire, vous pouvez tester un par un et choisissez le plus convenable pour vous ;) :ccool:

Un peu tard...

Citation:

Envoyé par hackoofr

:salut:
Testez cette version : ça devient une Source pas un code :mouarf: :king:

- Ajout BrowseForFolder pour parcourir le dossier à choisir.
- Ajout des icônes de dossiers et de fichiers.
- Ajout nombre de fichiers.
- Ajout taille de dossiers et de fichiers.

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
Option Explicit
Const outFile = "file.html"
Dim oFilesys,oFiletxt,Path,Ws,SourceImgFolder,StartTime,MsgTitre,DurationTime,objFolder,CheminDossier,Dossier,Copyright
Dim SizeKo,SizeMo,SizeGo,objShell,fso,size
Copyright = "© Hackoo © 2013"
MsgTitre = "Générer une arborescence d'un dossier en HTML "&Copyright&""
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier "&Copyright, 1, "c:\Programs")
If objFolder Is Nothing Then
        WScript.Quit
End If
CheminDossier = objFolder.self.path
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(CheminDossier)
If Dossier.Size = 0 Then
        MsgBox "Le Dossier " & CheminDossier & " est vide",16,"Dossier Vide"
        WScript.Quit
End if
    SizeKo = Round(FormatNumber(Dossier.Size)/(1024),1) & " Ko" 'Taille en Ko avec 1 chiffre après la Virgule
    SizeMo = Round(FormatNumber(Dossier.Size)/(1048576),1) & " Mo" 'Taille en Mo avec 1 chiffre après la Virgule
    SizeGo = Round(FormatNumber(Dossier.Size)/(1073741824),1) & " Go" 'Taille en Go avec 1 chiffre après la Virgule
 
	If Dossier.size < 1024 Then 
	   Size = Dossier.size & " Octets"
	elseif Dossier.size < 1048576 Then 
	   Size = SizeKo
	elseif Dossier.size < 1073741824 Then 
	   Size = SizeMo
	else
	   Size = SizeGo
	end If
Set oFilesys = CreateObject("Scripting.FileSystemObject")
Set oFiletxt = oFilesys.CreateTextFile(outFile,True)
Set Ws = CreateObject("Wscript.Shell")
 
oFiletxt.WriteLine("<html><body text=white bgcolor=#1234568><style type='text/css'>"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>")
SourceImgFolder = "http://upload.wikimedia.org/wikipedia/commons/a/a4/Icons-mini-folder.gif"
StartTime = Timer 'Début du Compteur Timer
oFiletxt.WriteLine("+ <img src="&SourceImgFolder&">  <a target=_Blank href='file:///" & CheminDossier & "'>" & CheminDossier & "</a><font color=""Yellow"">&nbsp;&nbsp;["&Size&"]</font><br><br>")
oFiletxt.WriteLine(List(CheminDossier))
oFiletxt.WriteLine("</body></hmtl>")
oFiletxt.Close
DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds." 'La durée de l'exécution du script
Ws.Popup "La génération au format HTML est terminée dans "& DurationTime & " !","5",MsgTitre,64
Ws.Run outFile
 
Function List(directory)
Dim fsoFolder,Folder,subfolders,objFile,objFolder,subfiles,SourceImgFile,NBFiles,Size,SizeKo,SizeMo,SizeGo,SourceImgFolder
On Error Resume next
    Set fsoFolder = CreateObject("Scripting.FileSystemObject")
    Set folder = fsoFolder.GetFolder(directory)
    Set subfolders = folder.SubFolders
    Set subfiles = folder.Files
    SourceImgFolder = "http://upload.wikimedia.org/wikipedia/commons/a/a4/Icons-mini-folder.gif"
    SourceImgFile = "http://upload.wikimedia.org/wikipedia/en/d/d8/VBSccript_file_format_icon.png"
    NBFiles = 0
    For each objFile in subfiles
    NBFiles = NBFiles + 1
    SizeKo = Round(FormatNumber(objFile.Size)/(1024),1) & " Ko" 'Taille en Ko avec 1 chiffre après la Virgule
    SizeMo = Round(FormatNumber(objFile.Size)/(1048576),1) & " Mo" 'Taille en Mo avec 1 chiffre après la Virgule
    SizeGo = Round(FormatNumber(objFile.Size)/(1073741824),1) & " Go" 'Taille en Go avec 1 chiffre après la Virgule
 
	If objFile.size < 1024 Then 
	   Size = objFile.size & " Octets"
	elseif objFile.size < 1048576 Then 
	   Size = SizeKo
	elseif objFile.size < 1073741824 Then 
	   Size = SizeMo
	else
	   Size = SizeGo
	end If
 
        oFiletxt.WriteLine("<dd>"& NBFiles &" |-<img src="&SourceImgFile&" height=""18"" width=""20"">  <a target=_Blank href='file:///" & objFile.Path & "'>" & objFile.Name & "</a>&nbsp;&nbsp;("&Size&")<br/>")
    Next
 
    For each objFolder in subfolders
         SizeKo = Round(FormatNumber(objFolder.Size)/(1024),1) & " Ko" 'Taille en Ko avec 1 chiffre après la Virgule
         SizeMo = Round(FormatNumber(objFolder.Size)/(1048576),1) & " Mo" 'Taille en Mo avec 1 chiffre après la Virgule
         SizeGo = Round(FormatNumber(objFolder.Size)/(1073741824),1) & " Go" 'Taille en Go avec 1 chiffre après la Virgule
 
     If objFolder.size < 1024 Then 
			Size = objFolder.size & " Octets"
     elseif objFolder.size < 1048576 Then 
         Size = SizeKo
     elseif objFolder.size < 1073741824 Then 
        Size = SizeMo
     else
        Size = SizeGo
     end If
 
        oFiletxt.WriteLine("<br><DL>+ <img src="&SourceImgFolder&">  <a target=_Blank href='file:///" & objFolder.Path & "'>" & objFolder.Path & "</a>&nbsp;&nbsp;<font color=""Yellow"">["&Size&"]</font><br><br/>")
        List(objFolder) 'Appel récusive de la fonction List
    Next    
End Function

Bonjour,
ton script est top, je voulais savoir si c'était possible de le faire en écrivant le résultat dans un fichier texte au lieu d'une page HTML, ou peut être un script plus simple pour toi, un script qui liste les premiers sous-dossiers d'un dossier sans les sous sous sous dossiers. Et mettre le résultat dans un fichier texte.
Par contre si je le teste sur un profil user j'ai le message d'erreur "accès refusé" pkoi? (je suis admin de mon poste)

:salut: Voici deux exemples : le premier avec un résultat en fichier texte et le second avec un résultat en fichier HTML
En format Texte :

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
38
Option Explicit
Const INT_MAX_LEVEL = 1
Const outFile = "ListeDossiers.txt"
Dim oFilesys,oFiletxt,Path,Ws,fso,StartTime,MsgTitre,DurationTime,objFolder,objShell,CheminDossier,Dossier,Copyright
Copyright = "© Hackoo © 2014"
MsgTitre = "Lister les dossiers "& Copyright &""
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier "&Copyright, 1, "c:\Programs")
If objFolder Is Nothing Then
        WScript.Quit
End If
CheminDossier = objFolder.self.path
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(CheminDossier)
 
Set oFilesys = CreateObject("Scripting.FileSystemObject")
Set oFiletxt = oFilesys.CreateTextFile(outFile,True)
Set Ws = CreateObject("Wscript.Shell")
 
StartTime = Timer 'Début du Compteur Timer
oFiletxt.WriteLine(CheminDossier)
oFiletxt.WriteLine(ListerDossier(CheminDossier,oFiletxt,1))
DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds." 'La durée de l'exécution du script
Ws.Popup "La génération au format Texte est terminée en "& DurationTime & " !","1",MsgTitre,64
Ws.Run outFile
 
Function ListerDossier(Schemin,oFiletxt,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-ObjSubReps
    Dim ObjSubRepItem
    For Each ObjSubRepItem In ObjSubRep 'Traiter chaque sous-ObjSubReps
    If Err <> 0 Then ws.popup Err.Description,"1",Err.Description,16
    oFiletxt.WriteLine (ObjSubRepItem.path) 'Ecrire le path
    If intLevel < INT_MAX_LEVEL Then ListerDossier ObjSubRepItem.Path, oFiletxt, intLevel + 1 'traiter les sous-ObjSubReps
    Next
End Function

En format HTML :

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
38
39
40
41
42
43
44
45
46
47
48
49
Option Explicit
Const INT_MAX_LEVEL = 1
Const outFile = "ListeDossiers.html"
Dim oFilesys,oFiletxt,Path,Ws,SourceImgFolder,StartTime,MsgTitre,DurationTime,objFolder,CheminDossier,Dossier,Copyright
Dim SizeKo,SizeMo,SizeGo,objShell,fso,size
Copyright = "© Hackoo © 2014"
MsgTitre = "Lister les dossiers "& Copyright &""
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier "&Copyright, 1, "c:\Programs")
If objFolder Is Nothing Then
        WScript.Quit
End If
CheminDossier = objFolder.self.path
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(CheminDossier)
If Err <> 0 Then ws.popup Err.Description,"1",Err.Description,16
 
Set oFilesys = CreateObject("Scripting.FileSystemObject")
Set oFiletxt = oFilesys.CreateTextFile(outFile,True)
Set Ws = CreateObject("Wscript.Shell")
 
oFiletxt.WriteLine("<html><body text=white bgcolor=#1234568><style type='text/css'>"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>")
SourceImgFolder = "http://upload.wikimedia.org/wikipedia/commons/a/a4/Icons-mini-folder.gif"
StartTime = Timer 'Début du Compteur Timer
oFiletxt.WriteLine("<img src="&SourceImgFolder&"><a target=_Blank href='file:///" & CheminDossier & "'>" & CheminDossier & "</a><br><br>")
oFiletxt.WriteLine(ListerDossier(CheminDossier,oFiletxt,1))
oFiletxt.WriteLine("</body></hmtl>")
'oFiletxt.Close
DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds." 'La durée de l'exécution du script
Ws.Popup "La génération au format HTML est terminée en "& DurationTime & " !","1",MsgTitre,64
Ws.Run outFile
 
Function ListerDossier(Schemin,oFiletxt,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-ObjSubReps
    Dim ObjSubRepItem
    For Each ObjSubRepItem In ObjSubRep 'Traiter chaque sous-ObjSubReps
    If Err <> 0 Then ws.popup Err.Description,"1",Err.Description,16
    oFiletxt.WriteLine ("<img src="&SourceImgFolder&"><a target=_Blank href='file:///" & ObjSubRepItem.path & "'>" & ObjSubRepItem.path & "</a><br>") 'Ecrire le path dans les lignes du Tableau en HTML
    If intLevel < INT_MAX_LEVEL Then ListerDossier ObjSubRepItem.Path, oFiletxt, intLevel + 1 'traiter les sous-ObjSubReps
    Next
End Function

08/10/2014, 10h29
arnaudperfect

Bonjour,

Ce post n'est pas récent, mais la même chose mais pour parser tous les répertoires et sous répertoires ?
Il faut ajouter quoi ? J'ai cru comprendre qu'il fallait ajouter la fonction "List(objFolder)" pour faire de la récursivité.
08/10/2014, 11h40
hackoofr

:salut:
Testez ce Vbscript : Dir2HTML.vbs

http://vb.developpez.com/telecharger/image/i/814/type

Cela fonctionne très bien.

Mais je souhaitais avoir un affichage en texte pour réalisé d'autres traitement par la suite. Aussi je souhaitais avoir que les répertoires et sous répertoire.
Mais j'ai trouvé la solution. Juste quelques modification de votre script.

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
38
Option Explicit
Const INT_MAX_LEVEL = 99
Const outFile = "ListeDossiers.txt"
Dim oFilesys,oFiletxt,Path,Ws,fso,StartTime,MsgTitre,DurationTime,objFolder,objShell,CheminDossier,Dossier,Copyright
Copyright = "© Hackoo © 2014"
MsgTitre = "Lister les dossiers "& Copyright &""
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier "&Copyright, 1, "c:\Programs")
If objFolder Is Nothing Then
        WScript.Quit
End If
CheminDossier = objFolder.self.path
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(CheminDossier)
 
Set oFilesys = CreateObject("Scripting.FileSystemObject")
Set oFiletxt = oFilesys.CreateTextFile(outFile,True)
Set Ws = CreateObject("Wscript.Shell")
 
StartTime = Timer 'Début du Compteur Timer
oFiletxt.WriteLine(CheminDossier)
oFiletxt.WriteLine(ListerDossier(CheminDossier,oFiletxt))
DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds." 'La durée de l'exécution du script
Ws.Popup "La génération au format Texte est terminée en "& DurationTime & " !","1",MsgTitre,64
Ws.Run outFile
 
Function ListerDossier(Schemin,oFiletxt) '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-ObjSubReps
    Dim ObjSubRepItem
    For Each ObjSubRepItem In ObjSubRep 'Traiter chaque sous-ObjSubReps
    If Err <> 0 Then ws.popup Err.Description,"1",Err.Description,16
    oFiletxt.WriteLine (ObjSubRepItem.path) 'Ecrire le path
    ListerDossier ObjSubRepItem.Path, oFiletxt 'traiter les sous-ObjSubReps
    Next
End Function

Encore merci pour votre travail et aide.

Arnaud