[VBs] Liste de dossiers et sous dossiers

**docofchaos** · 15/09/2013, 22h30

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 :

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

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

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 :

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

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'

**hackoofr** · 16/09/2013, 04h57

Juste il te manque un appel récursive dans la même fonction List(objFolder)

Dans la

il y a un exemple : Comment agir sur tous les fichiers d'un répertoire ?
Donc ton script devient :

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

**docofchaos** · 16/09/2013, 09h37

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 :

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

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

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

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 :

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

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

**hackoofr** · 16/09/2013, 16h17

Testez ce :

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

**docofchaos** · 16/09/2013, 20h12

bonsoir,

heu que dire,

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

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

**hackoofr** · 17/09/2013, 02h58

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

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

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

[VBs] Liste de dossiers et sous dossiers

VBScript

Vue hybride

Discussions similaires

Partager

Partager