Lister contenu répertoire dans excel

**YLKweb** · 13/09/2014, 12h02

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

**l_autodidacte** · 13/09/2014, 21h36

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

**YLKweb** · 14/09/2014, 00h13

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

**l_autodidacte** · 14/09/2014, 10h35

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.

**YLKweb** · 14/09/2014, 11h07

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.

**hackoofr** · 14/09/2014, 12h27

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

Lister contenu répertoire dans excel

VBScript

Vue hybride

Discussions similaires

Partager

Partager