IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBScript Discussion :

[VBs] Liste de dossiers et sous dossiers


Sujet :

VBScript

  1. #1
    Futur Membre du Club
    Profil pro
    Inscrit en
    Juillet 2012
    Messages
    17
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2012
    Messages : 17
    Points : 8
    Points
    8
    Par défaut [VBs] Liste de dossiers et sous dossiers
    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'

  2. #2
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut

    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

  3. #3
    Futur Membre du Club
    Profil pro
    Inscrit en
    Juillet 2012
    Messages
    17
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2012
    Messages : 17
    Points : 8
    Points
    8
    Par défaut
    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>

  4. #4
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut

    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

  5. #5
    Futur Membre du Club
    Profil pro
    Inscrit en
    Juillet 2012
    Messages
    17
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juillet 2012
    Messages : 17
    Points : 8
    Points
    8
    Par défaut
    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

  6. #6
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut

    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

  7. #7
    Membre confirmé Avatar de pitchalov
    Homme Profil pro
    Inscrit en
    Avril 2007
    Messages
    340
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 37
    Localisation : France

    Informations forums :
    Inscription : Avril 2007
    Messages : 340
    Points : 582
    Points
    582
    Par défaut
    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 : 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
    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

  8. #8
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut
    pitchalov d'avoir apporter vos grains de sel la dessus
    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
    Avez-vous une solution pour remédier ceci.
    et encore pour l’optimisation

  9. #9
    Membre confirmé Avatar de pitchalov
    Homme Profil pro
    Inscrit en
    Avril 2007
    Messages
    340
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 37
    Localisation : France

    Informations forums :
    Inscription : Avril 2007
    Messages : 340
    Points : 582
    Points
    582
    Par défaut
    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 . Ce n'est pas une fonction mais une procédure, l'appel doit plutôt se faire comme ça :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : 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
    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 : 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
    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

  10. #10
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut

    En utilisant la commande Unix Tree (Juste affichage de l'arborescence sans liens):
    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
    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

  11. #11
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut

    Juste si vous voulez aller plus loin ; Alors, vous pouvez le faire aussi en Autoit : Dir2HTML

  12. #12
    Membre du Club
    Homme Profil pro
    Consultant en sécurité
    Inscrit en
    Janvier 2014
    Messages
    36
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Gers (Midi Pyrénées)

    Informations professionnelles :
    Activité : Consultant en sécurité
    Secteur : Enseignement

    Informations forums :
    Inscription : Janvier 2014
    Messages : 36
    Points : 54
    Points
    54
    Par défaut
    Bonjour
    Ou est le meileure code ?
    Merci ^^

  13. #13
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut
    Citation Envoyé par ABOAT Voir le message
    Bonjour
    Ou est le meilleure code ?
    Merci ^^

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

  14. #14
    Membre à l'essai
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Décembre 2013
    Messages
    40
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Administration - Collectivité locale

    Informations forums :
    Inscription : Décembre 2013
    Messages : 40
    Points : 23
    Points
    23
    Par défaut Un peu tard...
    Citation Envoyé par hackoofr Voir le message

    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




    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)

  15. #15
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut
    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 : 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
    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 : 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
    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

  16. #16
    Membre actif
    Homme Profil pro
    Ingénieur systèmes et réseaux
    Inscrit en
    Décembre 2006
    Messages
    1 080
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 38
    Localisation : France, Seine Maritime (Haute Normandie)

    Informations professionnelles :
    Activité : Ingénieur systèmes et réseaux

    Informations forums :
    Inscription : Décembre 2006
    Messages : 1 080
    Points : 287
    Points
    287
    Par défaut
    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é.

  17. #17
    Expert éminent
    Avatar de hackoofr
    Homme Profil pro
    Enseignant
    Inscrit en
    Juin 2009
    Messages
    3 839
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 48
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 839
    Points : 9 222
    Points
    9 222
    Par défaut

    Testez ce Vbscript : Dir2HTML.vbs


  18. #18
    Membre actif
    Homme Profil pro
    Ingénieur systèmes et réseaux
    Inscrit en
    Décembre 2006
    Messages
    1 080
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 38
    Localisation : France, Seine Maritime (Haute Normandie)

    Informations professionnelles :
    Activité : Ingénieur systèmes et réseaux

    Informations forums :
    Inscription : Décembre 2006
    Messages : 1 080
    Points : 287
    Points
    287
    Par défaut
    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 : 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
    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

Discussions similaires

  1. [AC-2010] Listing de Fichier dans sous Dossier (Problem de Loop)
    Par FewRa dans le forum VBA Access
    Réponses: 2
    Dernier message: 11/08/2014, 11h02
  2. Réponses: 12
    Dernier message: 11/05/2012, 11h17
  3. lister dossier et sous dossier
    Par wabit dans le forum C
    Réponses: 6
    Dernier message: 06/06/2006, 16h48
  4. [VB6]lister les dossiers et sous dossier
    Par Jacen dans le forum VB 6 et antérieur
    Réponses: 2
    Dernier message: 28/04/2006, 08h06
  5. Réponses: 4
    Dernier message: 25/04/2006, 16h16

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo