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
| Dim ShellO: Set ShellO = CreateObject("WScript.Shell")
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim SListe: Dim Schemin
'Dossier à traiter
Schemin = InputBox("Entrez le chemin Absolu du dossier à lister "&vbCrlf&"Exemple c:\Program Files "&vbCrlf &_
"ou bien la Lettre du Lecteur exemple C:\ ou bien D:\","Arboréscence + Taille Dossier","c:\")
If Schemin = "" Then WScript.Quit
'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="<html><body text=white><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>"
strHTML=strHTML & "<center><h2><B><font color=red>Liste des Dossiers et Sous-Dossiers dans " & Schemin & " et leurs tailles </font></B></h2></center>" & _
"<center><body bgcolor=#1234568><table border='3' cellpadding='1' style='border-collapse: collapse; font size:11pt' bordercolor='#CCCCCC' width='auto' id='Table1'></center>" & _
"<tr><td><center><strong>Chemin des Dossiers :</strong></center></td>" &_
"<td><center><strong>Taille :</strong></center></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></body></html>" '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
Set f = fso.GetFolder(ObjSubRepItem)
SizeKo = Round(FormatNumber(f.Size)/(1024),2) & " Ko" 'Taille en Ko avec 2 chiffres après la Virgule
SizeMo = Round(FormatNumber(f.Size)/(1048576),2) & " Mo"'Taille en Mo avec 2 chiffres après la Virgule
SizeGo = Round(FormatNumber(f.Size)/(1073741824),2) & " Go" 'Taille en Go avec 2 chiffres après la Virgule
If f.size < 1024 Then
Fichier.WriteLine ("<tr><td><a href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</td><td>" & f.size & " Octet </a></td></tr>") 'Ecrire le path dans les lignes du Tableau en HTML
elseif f.size < 1048576 Then
Fichier.WriteLine ("<tr><td><a href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</td><td>" & SizeKo & "</a></td></tr>") 'Ecrire le path dans les lignes du Tableau en HTML
elseif f.size < 1073741824 Then
Fichier.WriteLine ("<tr><td><a href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</td><td>" & SizeMo & "</a></td></tr>") 'Ecrire le path dans les lignes du Tableau en HTML
else
Fichier.WriteLine ("<tr><td><a href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</td><td>" & SizeGo & "</a></td></tr>") 'Ecrire le path dans les lignes du Tableau en HTML
end if
ListerDossier ObjSubRepItem.Path, Fichier 'traiter les sous-dossiers
Next
ShellO.run "Liste.html"
End Function |
Partager