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 :

Lister contenu répertoire dans excel


Sujet :

VBScript

  1. #1
    Nouveau membre du Club
    Administrateur systèmes et réseaux
    Inscrit en
    Avril 2013
    Messages
    36
    Détails du profil
    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux

    Informations forums :
    Inscription : Avril 2013
    Messages : 36
    Points : 26
    Points
    26
    Par défaut Lister contenu répertoire dans excel
    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 : 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
    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

  2. #2
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    Juillet 2009
    Messages
    2 415
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 68
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : Juillet 2009
    Messages : 2 415
    Points : 5 806
    Points
    5 806
    Par défaut
    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 : 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
    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
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA) et Ne jamais typer variables et/ou fonctions en VBS.
    Vous pouvez consulter mes contributions
    Ne pas oublier de consulter les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  3. #3
    Nouveau membre du Club
    Administrateur systèmes et réseaux
    Inscrit en
    Avril 2013
    Messages
    36
    Détails du profil
    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux

    Informations forums :
    Inscription : Avril 2013
    Messages : 36
    Points : 26
    Points
    26
    Par défaut
    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 : 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
    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
     
     
    '--------------------------------------------------------------------------------------------------------------------

  4. #4
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    Juillet 2009
    Messages
    2 415
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 68
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : Juillet 2009
    Messages : 2 415
    Points : 5 806
    Points
    5 806
    Par défaut
    Pour
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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.
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Balises CODE indispensables. Regardez ICI
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA) et Ne jamais typer variables et/ou fonctions en VBS.
    Vous pouvez consulter mes contributions
    Ne pas oublier de consulter les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  5. #5
    Nouveau membre du Club
    Administrateur systèmes et réseaux
    Inscrit en
    Avril 2013
    Messages
    36
    Détails du profil
    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux

    Informations forums :
    Inscription : Avril 2013
    Messages : 36
    Points : 26
    Points
    26
    Par défaut
    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.

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

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 836
    Points : 9 217
    Points
    9 217
    Par défaut

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


  7. #7
    Nouveau membre du Club
    Administrateur systèmes et réseaux
    Inscrit en
    Avril 2013
    Messages
    36
    Détails du profil
    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux

    Informations forums :
    Inscription : Avril 2013
    Messages : 36
    Points : 26
    Points
    26
    Par défaut
    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.

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

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 836
    Points : 9 217
    Points
    9 217
    Par défaut
    Citation Envoyé par YLKweb Voir le message
    Je ne parviens pas à charger la page de téléchargement de ton script...
    Juste vous cliquez sur l'image

  9. #9
    Nouveau membre du Club
    Administrateur systèmes et réseaux
    Inscrit en
    Avril 2013
    Messages
    36
    Détails du profil
    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux

    Informations forums :
    Inscription : Avril 2013
    Messages : 36
    Points : 26
    Points
    26
    Par défaut
    Citation Envoyé par hackoofr Voir le message
    Juste vous cliquez sur l'image

    ...

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

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

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 836
    Points : 9 217
    Points
    9 217
    Par défaut

    Voici le code de Dir2HTML.vbs
    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
    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
     '**********************************************************************************************

  11. #11
    Nouveau membre du Club
    Administrateur systèmes et réseaux
    Inscrit en
    Avril 2013
    Messages
    36
    Détails du profil
    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux

    Informations forums :
    Inscription : Avril 2013
    Messages : 36
    Points : 26
    Points
    26
    Par défaut
    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.

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

    Informations professionnelles :
    Activité : Enseignant

    Informations forums :
    Inscription : Juin 2009
    Messages : 3 836
    Points : 9 217
    Points
    9 217
    Par défaut
    Citation Envoyé par YLKweb Voir le message
    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 par les +1

  13. #13
    Nouveau membre du Club
    Administrateur systèmes et réseaux
    Inscrit en
    Avril 2013
    Messages
    36
    Détails du profil
    Informations professionnelles :
    Activité : Administrateur systèmes et réseaux

    Informations forums :
    Inscription : Avril 2013
    Messages : 36
    Points : 26
    Points
    26
    Par défaut
    Autant pour moi...

    Voilà qui est rectifié pour vous deux.

    A bientôt !

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [Batch] Lister les répertoires dans un fichier
    Par Olivier Regnier dans le forum Scripts/Batch
    Réponses: 7
    Dernier message: 30/03/2010, 23h35
  2. Lister sous-répertoires dans un Tlistbox (Sans liens)
    Par Brain3D dans le forum Débuter
    Réponses: 4
    Dernier message: 11/03/2009, 22h56
  3. Lister un répertoire dans une fenêtre
    Par azsoundcore61 dans le forum C++Builder
    Réponses: 10
    Dernier message: 14/02/2007, 12h56

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