Lister contenu répertoire dans excel

Version imprimable

Bonjour à tous !

J'ai une petite requête concernant un VBS un peu spécial.
Voilà, j'ai créé un petit script pour lister les fichiers (et uniquement les fichiers) d'un répertoire et ses sous-répertoires (sur le réseau) puis les sortir dans un fichier Excel.

Seulement le fichier excel que j'obtiens est "brut" et se contente de mettre le chemin complet de chaque fichier trouvé sur une nouvelle ligne...
Autant dire que c'est assez difficile à traiter lorsque le nombre de fichiers est important.

J'aurais aimé pouvoir afficher les informations de manière plus organisées dans le fichier excel comme par exemple sous forme de tableau avec le nom des dossiers dans lequel des fichiers ont été trouvés en guise d'entête de colonne, et les fichiers trouvés dans chaque colonne correspondante.
Pour couronner le tout j'aurais aimé avoir le total des fichiers trouvés pour chaque répertoire et le total général des fichiers trouvés.

J'avoue que ce genre de traitement "fin" dépasse de très loin mes compétences si tant est qu'il soit possible de l'obtenir avec un simple VBS...

Si ce genre d'opération n'est pas faisable via un VBS, je suis preneur de toute idée me permettant d'arriver à obtenir ces infos (même si la présentation est plus "brut").

Après, pour ma culture, savez-vous comment je pourrais ajouter à mon script actuel une ligne me permettant de limiter la recherche à un ou deux types de fichiers spécifiques (comme par exemple uniquement les extensions en .DOC et .PDF) ?

J'espère que quelqu'un saura compléter mon script et m'aider à trouver des réponses.

Merci d'avance amis développeurs !

Voici le code de mon script actuel :
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 Dim oNet Set oNet = CreateObject("Wscript.Network") oNet.MapNetworkDrive "V:", "\\SERVEUR\Partage" Set objFSO = CreateObject("Scripting.FileSystemObject") If objFSO.DriveExists("V:") = True Then Dim ShellO: Set ShellO = CreateObject("WScript.Shell") Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject") Dim SListe: Dim Schemin Schemin = "V:" SListe = ShellO.SpecialFolders("Desktop") If Right(SListe, 1) <> "\" Then SListe = SListe & "\" Dim Fichier: Set Fichier = FSO.CreateTextFile(SListe & "Liste.xls", 1, True) ListerDossier Schemin, Fichier Fichier.Close Function ListerDossier(Schemin, Fichier) On Error Resume Next Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject") Dim ObjRep: Set ObjRep = FSO.GetFolder(Schemin) Dim ObjSubRep: Set ObjSubRep = ObjRep.SubFolders Dim ObjSubRepItem For Each ObjSubRepItem In ObjSubRep ListerDossier ObjSubRepItem.Path, Fichier Next Dim ObjRepFind: Set ObjRepFind = FSO.GetFolder(Schemin) Dim ObjSubFile: Set ObjSubFile = ObjRepFind.Files Dim ObjSubFileItem For Each ObjSubFileItem In ObjSubFile Fichier.WriteLine ObjSubFileItem.Path Next End Function Else WScript.Quit End If Call Etape_Finale() Function Etape_Finale() oNet.RemoveNetworkDrive "V:",true set oXL = WScript.CreateObject("EXCEL.application" ) oXL.Visible = True oXL.workbooks.open (SListe & "Liste.xls") End Function

Salut;
Voici une autre variante du script qui affiche ce que tu as demandé avec en entête le nom du dossier /sous-dossier suivi du nombre de fichiers qui s'y trouvent.
Si un sous-dossier est vide, il n'est pas répertorié.
A toi d'adapter selon ton lecteur réseau car je ne peux pas le tester vu que je n'en ai pas :

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
Option Explicit
 
Dim oFSO, oFld, WS, XL, Wbook, wSheet, Cnt,oFL, stRep, SListe, X
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    stRep = "C:\Temp"
    set XL   = WScript.CreateObject("EXCEL.application" )
    Set WS = CreateObject("WScript.Shell")
    'XL.workbooks.open   (SListe & "Liste.xls")
    SListe = WS.SpecialFolders("Desktop")
    If Right(SListe, 1) <> "\" Then SListe = SListe & "\"
    Dim Fichier: Set Fichier = oFSO.CreateTextFile(SListe & "Liste.xls", 1, True)
    Fichier.Close
    XL.workbooks.open SListe & "Liste.xls"
    Set wSheet = XL.Worksheets(1)
    ListeFichRacine stRep
    Cnt = 1    
    DirRep stRep 
    XL.WorkBooks(1).Save
    XL.Visible = True
    XL.DisplayAlerts = False
    'XL.Quit
    'Set XL = Nothing
'===================================
' Liste les fichier des sous-dossiers    
Sub DirRep (stRep )
     For Each oFld In  oFSO.GetFolder(stRep).SubFolders
       If oFld.Files.Count <> 0 Then 
          cnt = cnt +1
          wSheet.Cells(1, cnt) = oFld.PAth & " : " & oFld.Files.Count 
          ListeFichier oFld.PATH, cnt
       End If
       DirRep oFld.PATH
     Next
End Sub
'===============================
' Liste les fichiers du répertoire
Sub ListeFichier(stRep, ByVal Y)
     X = 2 : On Error Resume Next
     If oFSO.GetFolder(stRep).Files.Count = 0 Then Exit Sub
     If Y = 0 Then Y = 2
     For each oFl in  oFSO.GetFolder(stRep).Files
       wSheet.Cells(X, Y) = oFl.Name
       X = X + 1
     Next
End Sub
'===============================
' Liste les fichier du dossier racine
Sub ListeFichRacine(stRep)
    Dim Y 
    Y = 1
    X = 2 ': On Error Resume Next
     If oFSO.GetFolder(stRep).Files.Count = 0 Then Exit Sub
     wSheet.Cells(1, 1) = StRep & " : " & oFSO.GetFolder(stRep).Files.Count
     'If Y = 0 Then Y = 2
     For each oFl in  oFSO.GetFolder(stRep).Files
       wSheet.Cells(X, Y) = oFl.Name
       X = X + 1
     Next
End Sub

Tu m'épate l'ami !
C'est nickel, je viens de tester en mappant mon lecteur et ça marche.
Encore merci, t'es un chef !

Puisque je constate que tu es particulièrement doué, puis-je me permettre d'abuser ?

Aurais-tu idée de la ligne à ajouter pour limiter le listing aux seuls fichiers JGP et TIF par exemple ?
Simple curiosité bien sûr. Ne te prends pas trop la tête si ça t'oblige à tout remanier.

Autre chose, je viens de dégotter (après de longues recherches sur le net) un script assez sympa me permettant de faire, à peu de choses près, ce que tu viens de me donner, à la différence qu'il envoi le résultat vers un fichier HTML et qu'il ne compte pas le nombre de fichiers trouvés dans chaque répertoire...
Je te laisse le code ici, penses-tu qu'il serait compliqué d'y ajouter la fonctionnalité permettant de compter les fichiers et les afficher sur le HTML en sortie ?

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
100
101
102
103
104
105
'choix du répertoire
nomrep=inputbox("Chemin du r" & Chr(233) & "pertoire",,"G:\Musiques")
 
Set sh = WScript.CreateObject("WScript.Shell") 
Set fs = CreateObject("Scripting.FileSystemObject") 
 
'traiter le cas où nomrep est un disque ou un nom non valide
if not fs.folderexists(nomrep) or ucase(fs.getdrivename(nomrep))=ucase(replace(nomrep,"\","")) then
MsgBox "Chemin du r" & Chr(233) & "pertoire non valide"
wscript.quit
end if
Set rep=fs.getFolder(nomrep)
spc="&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
 
'-----------------------------------------------
'créer un tableau contenant tous les noms de répertoires avec leur niveau
nb_niveaux_max=inputbox("Nombre de niveaux de recherche",,1)
if not isnumeric(nb_niveaux_max) or nb_niveaux_max=0 then nb_niveaux_max=1
nb_niveaux_max=nb_niveaux_max+1
redim reps(nb_niveaux_max,1)
'initialiser le tableau
reps(0,0)=rep.path
'remplir le tableau
explore 0,0
 
'-----------------------------------------------
'texte de sortie
esse=""
if nb_niveaux_max-1>1 then esse="x"
'balayer le tableau pour créer le txt de sortie
txt="<HTML><BODY BGCOLOR='ivory'><STYLE> A {text-decoration:none}</STYLE><BR><CENTER><FONT SIZE='+1'>Contenu du r" & Chr(233) & "pertoire " & nomrep & "</FONT><BR>(" & nb_niveaux_max-1 & " niveau" & esse & ")</CENTER><BR><BR><DIR>"
 
for lin=0 to ubound(reps,2)
blancs=""
 
for col=0 to ubound(reps,1)
 
tt=reps(col,lin)
if tt="" then 
	blancs=blancs & spc
else
	set rpt=fs.getfolder(tt)
	'enregistrer le nom du répertoire et les fichiers
	txt=txt & blancs & rpt.name & "<BR>" & chr(10)
	'fichiers
	if col<nb_niveaux_max-1 then
	for each fch in rpt.files
	txt=txt & blancs & spc & "<A HREF='" & fch.path & "' target='_blank'><FONT COLOR='blue' SIZE='-1'>" & fch.name & "</FONT></A><BR>" & chr(10)
	next
	end if
	exit for 'on arrete de balayer la ligne
end if
 
next  'col
 
if tt="" then exit for
next 'lin
 
txt=txt & "</DIR></BODY></HTML>"
 
'-----------------------------------------------
'afficher les résultats
fichresult="c:\rien.html"
Set nouv_fich = fs.OpenTextFile(fichresult, 2, true)
nouv_fich.write txt
nouv_fich.close
sh.run "iexplore " & fichresult
 
 
'--------------------------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------------------------
 
sub explore(lin,col)
'met à jour tableau reps(numéro,niveau)
set rep=fs.getFolder(reps(col,lin))
for each ssrep in rep.subfolders
if col<ubound(reps,1)-1 then 'limite le nb de niveaux
decale(lin)
reps(col+1,lin+1)=ssrep.path
lin=lin+1
explore lin,col+1
end if
next
end sub
 
 
'--------------------------------------------------------------------------------------------------------------------
 
 
sub decale(ln)
'fait de la place sous la ligne ln
redim preserve reps(ubound(reps,1),ubound(reps,2)+1)
for nln=ubound(reps,2) to ln+2 step -1
for ncl=0 to ubound(reps,1)
reps(ncl,nln)=reps(ncl,nln-1)
next
next
'vider ligne ln+1
for ncl=0 to ubound(reps,1)
reps(ncl,ln+1)=""
next
end sub
 
 
'--------------------------------------------------------------------------------------------------------------------

14/09/2014, 10h35
l_autodidacte
Pour

Citation:

Aurais-tu idée de la ligne à ajouter pour limiter le listing aux seuls fichiers JGP et TIF par exemple ?

il suffit de remplacer dans le code que j'ai envoyé les lignes 42 et 43 par :
Code:

1 2 3 4 If Right(LCase(oFl.Name),4) = ".jpg" Or Right(LCase(oFl.Name),4) = ".tif" Then wSheet.Cells(X, Y) = oFl.Name X =X + 1 End If
de même pour les lignes 56 et 57

Pour le reste oui, mais cela prend un peu de temps dont malheureusement je ne dispose pas pour le moment.
14/09/2014, 11h07
YLKweb

Ok merci à toi pour le temps que tu m'as déjà accordé. :)
Ton script m'est d'ailleurs bien utile.

Pour l'autre script, je lance donc un appel aux autres développeurs confirmés du forum, si vous avez un peu de temps et une idée pour ajouter un compteur sur les fichiers trouvés dans chaque répertoire puis l'ajouter au fichier HTML de sortie, ce serait le bonheur !

Merci d'avance.
14/09/2014, 12h27
hackoofr

:salut:
Tu peux aussi t'inspirer de ce Vbscript : [VBS] Dir2HTML.vbs

http://vb.developpez.com/telecharger/image/i/814/
14/09/2014, 12h53
YLKweb

Salut et merci Hackoo,

Ça a l'air intéressant en effet mais... Je ne parviens pas à charger la page de téléchargement de ton script...
Tu pourrais recoller le code ici stp ?

Merci d'avance. :)
14/09/2014, 13h34
hackoofr

Citation:

Envoyé par YLKweb

Je ne parviens pas à charger la page de téléchargement de ton script...

Juste vous cliquez sur l'image :mouarf:
14/09/2014, 14h55
YLKweb

Citation:

Envoyé par hackoofr

Juste vous cliquez sur l'image :mouarf:

... :weird:

Ça j'avais compris, merci...
Mais justement, une fois redirigé sur la page de ton script, le téléchargement ne se lance jamais en cliquant sur le lien du VB, même après s'être identifié...
Pour être précis, c'est la page http://vb.developpez.com/telecharger...r2HTML-vbs.htm qui semble ne jamais se charger (chez moi en tous cas).

D'où ma demande...

:salut:
Voici le code de Dir2HTML.vbs :king:

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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
Option Explicit
 Dim oFilesys,oFiletxt,Path,Ws,SourceImgFolder,StartTime,MsgTitre,DurationTime,objFolder,CheminDossier,Dossier,Copyright
 Dim SizeKo,SizeMo,SizeGo,objShell,size,Sig,OutFile,MsgAttente,oExec,Temp
 Copyright = "© Hackoo © 2014"
 Set ws = CreateObject("wscript.Shell")
 Temp = ws.ExpandEnvironmentStrings("%Temp%")
 MsgTitre = "Generer une arborescence d'un dossier en HTML "&Copyright&""
 MsgAttente = "Veuillez patienter un peu la generation est en cours..."
 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
 OutFile = objFolder.self.name &".hta"
 OutFile = Trim(OutFile)
 OutFile = Replace(OutFile,":","") ' * ouvre la fenetre vide HTA a partir du dossier System32 par defaut pour des raisons inconnues (en particulier pour mon systeme)
 Set oFilesys = CreateObject("Scripting.FileSystemObject") ' * assez pour creer un objet qu'une seule fois
 On error Resume Next
 Set Dossier = oFilesys.GetFolder(CheminDossier)
 If Err <> 0 Then
     MsgBox Err.Number & VbCrLF & Err.Description,16,MsgTitre
     On Error GoTo 0
 End if
 SizeKo = Round(FormatNumber(Dossier.Size)/(1024),2) & " Ko" 'Taille en Ko avec 2 chiffres apres la Virgule
 SizeMo = Round(FormatNumber(Dossier.Size)/(1048576),2) & " Mo" 'Taille en Mo avec 2 chiffres apres la Virgule
 SizeGo = Round(FormatNumber(Dossier.Size)/(1073741824),2) & " Go" 'Taille en Go avec 2 chiffres apres 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 oFiletxt = oFilesys.CreateTextFile(OutFile,True,-1)
 Set Ws = CreateObject("Wscript.Shell")
 
 oFiletxt.WriteLine("<html><HTA:APPLICATION SCROLL=""yes"" WINDOWSTATE=""Maximize""icon=""verifier.exe""><body text=white bgcolor=#1234568>"&_
 "<meta content=""text/html; charset=UTF-8"" http-equiv=""content-type"">"&_
 "<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 "<SCRIPT LANGUAGE=""VBScript"">"
 oFiletxt.writeline "Function Explore(filename)"
 oFiletxt.writeline "Set ws=CreateObject(""wscript.Shell"")"
 oFiletxt.writeline "ws.run ""Explorer /n,/select,""&filename&"""""
 oFiletxt.writeline "End Function"
 oFiletxt.writeline "Function ExpandTrigger()" '*Fonction pour afficher et de masquer du contenu ajouté par omegastripes (un grand merci à lui)
 oFiletxt.writeline "    With Window.Event.SrcElement" 'http://www.visualbasicscript.com/fb.ashx?m=104343
 oFiletxt.writeline "        If .FirstChild.NodeValue = ""+"" Then"
 oFiletxt.writeline "            .FirstChild.NodeValue = ""–"""
 oFiletxt.writeline "            .NextSibling.NextSibling.NextSibling.Style.Display = ""inline"""
 oFiletxt.writeline "        Else"
 oFiletxt.writeline "            .FirstChild.NodeValue = ""+"""
 oFiletxt.writeline "            .NextSibling.NextSibling.NextSibling.Style.Display = ""none"""
 oFiletxt.writeline "        End If"
 oFiletxt.writeline "    End With"
 oFiletxt.writeline "End Function"
 oFiletxt.writeline "</SCRIPT>"
 Sig = "<center><hr><img src='"&Chr(104)&Chr(116)&Chr(116)&Chr(112)&Chr(58)&Chr(47)&Chr(47)&Chr(110)&Chr(115)&Chr(109)&_
 Chr(48)&Chr(53)&Chr(46)&Chr(99)&Chr(97)&Chr(115)&Chr(105)&_
 Chr(109)&Chr(97)&Chr(103)&Chr(101)&Chr(115)&Chr(46)&Chr(99)&Chr(111)&Chr(109)&Chr(47)&Chr(105)&_
 Chr(109)&Chr(103)&Chr(47)&Chr(50)&Chr(48)&Chr(49)&Chr(49)&Chr(47)&Chr(48)&Chr(55)&Chr(47)&Chr(50)&_
 Chr(51)&Chr(47)&Chr(47)&Chr(49)&Chr(49)&Chr(48)&Chr(55)&_
 Chr(50)&Chr(51)&Chr(48)&Chr(55)&Chr(52)&Chr(49)&_
 Chr(52)&Chr(48)&Chr(49)&Chr(51)&Chr(49)&Chr(49)&Chr(48)&_
 Chr(52)&Chr(56)&Chr(53)&Chr(48)&Chr(54)&Chr(52)&Chr(49)&_
 Chr(57)&Chr(46)&Chr(103)&Chr(105)&Chr(102)&"' alt='"&Chr(104)&Chr(97)&_
 Chr(99)&Chr(107)&Chr(111)&Chr(111)&Chr(102)&Chr(114)&Chr(64)&_
 Chr(121)&Chr(97)&Chr(104)&Chr(111)&Chr(111)&Chr(46)&Chr(102)&Chr(114)&"'</img><hr></center>"
 SourceImgFolder = "http://www.webmasters.by/images/articles/css-tree/folder-horizontal.png"
 '"http://upload.wikimedia.org/wikipedia/commons/a/a4/Icons-mini-folder.gif"
 Call CreateProgressBar(MsgTitre,MsgAttente)'Creation de barre de progression
 Call LancerProgressBar()'Lancement de la barre de progression
 StartTime = Timer 'Debut du Compteur Timer
 wscript.sleep 5000
 oFiletxt.WriteLine("<span onclick='ExpandTrigger' style='cursor: pointer;'>+</span><span> <img src="&SourceImgFolder&"><A href=""#"" OnClick='Explore("""& CheminDossier & """)'>" & CheminDossier & "</A><font color=""Yellow"">&nbsp;&nbsp;["&Size&"]</font></span><br>") ' * l'obtention de la structure necessaire pour la fonction
 oFiletxt.WriteLine("<div style='display: none;'>")
 List(CheminDossier)
 oFiletxt.WriteLine("</div>")
 oFiletxt.WriteLine(Sig)
 oFiletxt.WriteLine("</body></hmtl>")
 oFiletxt.Close
 Call FermerProgressBar()'Fermeture de barre de progression
 DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds." 'La duree de l'execution du script
 Ws.Popup "La generation au format HTML est terminee en "& DurationTime & " !","2",MsgTitre,64
 Ws.Run DblQuote(OutFile), 1, True ' * apres l'utilisation
 'oFilesys.DeleteFile OutFile, True ' * nettoyage de debris
 '*********************************************************************************
 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://www.webmasters.by/images/articles/css-tree/folder-horizontal.png"
     '"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),2) & " Ko" 'Taille en Ko avec 2 chiffres apres la Virgule
         SizeMo = Round(FormatNumber(objFile.Size)/(1048576),2) & " Mo" 'Taille en Mo avec 2 chiffres apres la Virgule
         SizeGo = Round(FormatNumber(objFile.Size)/(1073741824),2) & " Go" 'Taille en Go avec 2 chiffres apres 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("<dt>"& NBFiles &" |-<img src="&SourceImgFile&" height=""14"" width=""14""><A href=""#"" OnClick='Explore("""& objFile.Path & """)'>" & objFile.Name & "</A>&nbsp;&nbsp;("&Size&")</dt><br>")
     Next
 
     For each objFolder in subfolders
         SizeKo = Round(FormatNumber(objFolder.Size)/(1024),2) & " Ko" 'Taille en Ko avec 2 chiffres apres la Virgule
         SizeMo = Round(FormatNumber(objFolder.Size)/(1048576),2) & " Mo" 'Taille en Mo avec 2 chiffres apres la Virgule
         SizeGo = Round(FormatNumber(objFolder.Size)/(1073741824),2) & " Go" 'Taille en Go avec 2 chiffres apres 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("<DL><hr>")
         oFiletxt.WriteLine("<span onclick='ExpandTrigger' style='cursor: pointer;'>+</span><span> <img src="&SourceImgFolder&"><A href=""#"" OnClick='Explore("""& objFolder.Path & """)'>" & objFolder.Path & "</A>&nbsp;&nbsp;<font color=""Yellow"">["&Size&"]</font></span><br>") ' * l'obtention de la structure necessaire pour la fonction
         oFiletxt.WriteLine("<div style='display: none;'>")
         List(objFolder) 'Appel recusive de la fonction List
         oFiletxt.WriteLine("</div>")
         oFiletxt.WriteLine("</DL>")
     Next   
 End Function
 '****************************************************************************************************
 Sub CreateProgressBar(Titre,MsgAttente)
     Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
     Set ws = CreateObject("wscript.Shell")
     Set fso = CreateObject("Scripting.FileSystemObject")
     Temp = WS.ExpandEnvironmentStrings("%Temp%")
     PathOutPutHTML = Temp & "\Barre.hta"
     Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
     fhta.WriteLine "<HTML>"
     fhta.WriteLine "<HEAD>"
     fhta.WriteLine "<Title>  " & Titre & "</Title>"
     fhta.WriteLine "<HTA:APPLICATION"
     fhta.WriteLine "ICON = ""magnify.exe"" "
     fhta.WriteLine "BORDER=""THIN"" "
     fhta.WriteLine "INNERBORDER=""NO"" "
     fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
     fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
     fhta.WriteLine "SCROLL=""NO"" "
     fhta.WriteLine "SYSMENU=""NO"" "
     fhta.WriteLine "SELECTION=""NO"" "
     fhta.WriteLine "SINGLEINSTANCE=""YES"">"
     fhta.WriteLine "</HEAD>"
     fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
     fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
     fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
     fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
     fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
     fhta.WriteLine "Sub window_onload()"
     fhta.WriteLine "    CenterWindow 430,90"
     fhta.WriteLine "    Self.document.bgColor = ""Orange"" "
     fhta.WriteLine " End Sub"
     fhta.WriteLine " Sub CenterWindow(x,y)"
     fhta.WriteLine "    Dim iLeft,itop"
     fhta.WriteLine "    window.resizeTo x,y"
     fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
     fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
     fhta.WriteLine "    window.moveTo ileft,itop"
     fhta.WriteLine "End Sub"
     fhta.WriteLine "</script>"
     fhta.close
 End Sub
 '**********************************************************************************************
 Sub LancerProgressBar()
     Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
 End Sub
 '**********************************************************************************************
 Sub FermerProgressBar()
     oExec.Terminate
 End Sub
 '**********************************************************************************************
 Function DblQuote(Str)
     DblQuote = Chr(34) & Str & Chr(34)
 End Function
 '**********************************************************************************************

14/09/2014, 17h09
YLKweb

Merci bien Hackoo.
Ce script est vraiment sympa.

Entre ta contribution et celle de l_autodidacte, je crois pouvoir mettre le statut du topic sur résolu.

Merci encore à vous, vous êtes trop forts. :)

A bientôt.
14/09/2014, 17h16
hackoofr

Citation:

Envoyé par YLKweb

Merci bien Hackoo.
Ce script est vraiment sympa.
Entre ta contribution et celle de l_autodidacte, je crois pouvoir mettre le statut du topic sur résolu.
Merci encore à vous, vous êtes trop forts. :)
A bientôt.

Oui, mais il faut traduire le :merci: par les +1 :plusser: :king: :mrgreen: ;)
14/09/2014, 19h02
YLKweb

Autant pour moi... :)

Voilà qui est rectifié pour vous deux. ;)

A bientôt !