Recuperer les noms des sous-dossiers et des fichiers

Version imprimable

Bonjour,

J'ai un dossier c:\test\
je veux recuperer ( dans fichier text) les noms de tous les sous dossiers et aussi les fichiers d'extension .txt dans chaque sous dossier . comme :
dossier fichier
c:\test\dossier1 A.txt;B.txt;C.txt

c:\test\dossier2 Z.txt;d.txt

Merci d'avance.
J'ai essayé le code suivant mais ça marche pas bien :cry:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
 
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objmyFolder = objFso.GetFolder("D:\Test")
 
Const ForReading = 1, ForWriting = 2
  Set WshShell = WScript.CreateObject("WScript.Shell")
   Dim fso, f
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpenTextFile("D:\file_folder.txt", ForWriting,true)
   f.write("Dossier")
   f.write  vbTab &("Fichier")& vbCrlf
 
ListDirectory objMyFolder
 
Set FSO = CreateObject("Scripting.FileSystemObject")
 
Sub ListDirectory(objFolder)
 
 For Each objSubFolder In objFolder.SubFolders
    f.write  objSubFolder.Name  & vbTab 
    ListDirectory(objSubFolder )
 
    For Each objFile In  objFolder.Files
       If UCase(FSO.GetExtensionName(objfile.Path)) = "TXT" Then
 
           f.write objFile.Name
	   f.write(";")
       end if
    Next
 
   f.write ("") & vbCrlf 
 Next
End Sub

:salut:
Testez ce code pour Lister les Dossiers et sous-Dossiers

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Dim ShellO: Set ShellO = CreateObject("WScript.Shell")
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim SListe: Dim Schemin
'Dossier à traiter
 
Schemin = InputBox("Entrez le chemin Absolu du dossier à lister "&vbCrlf&"Exemple c:\Program Files "&vbCrlf &_
"ou bien la Lettre du Lecteur exemple C:\ ou bien D:\","Arboréscence + Taille Dossier","c:\")
If Schemin = "" Then WScript.Quit 
'Dossier Bureau de windows + "\"
SListe = ShellO.SpecialFolders("Desktop")
If Right(SListe, 1) <> "\" Then SListe = SListe & "\"
'Ouverture du fichier contenant l'arborescence du répertoire à traiter vers le Bureau
Dim Fichier: Set Fichier = FSO.CreateTextFile(SListe & "Liste.html", 1, True) 
 
strHTML="<html><body text=white><style type='text/css'>"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>"
 
strHTML=strHTML & "<center><h2><B><font color=red>Liste des Dossiers et Sous-Dossiers dans " & Schemin & " et leurs tailles </font></B></h2></center>" & _
 "<center><body bgcolor=#1234568><table border='3' cellpadding='1' style='border-collapse: collapse; font size:11pt' bordercolor='#CCCCCC' width='auto' id='Table1'></center>" & _
 "<tr><td><center><strong>Chemin des Dossiers :</strong></center></td>" &_
 "<td><center><strong>Taille :</strong></center></td></tr>"
'Fichier.WriteLine (Schemin & "<br>")			  
Fichier.WriteLine strHTML 'Ecrire la structure du Tableau en HTML
ListerDossier Schemin, Fichier 'Remplissage dynamique des données dans le Tableau 
Fichier.WriteLine "</table></body></html>" 'ici on ferme notre tableau par la balise </table>
'Fermeture du fichier contenant l'arborescence du répertoire à traiter
Fichier.Close
 
Function ListerDossier(Schemin, Fichier) 'Lister l'arborescence du dossier
On Error Resume Next
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim ObjRep: Set ObjRep = FSO.GetFolder(Schemin) 'dossier
Dim ObjSubRep: Set ObjSubRep = ObjRep.SubFolders 'sous-dossiers
Dim ObjSubRepItem
For Each ObjSubRepItem In ObjSubRep 'Traiter chaque sous-dossiers
 
Set f = fso.GetFolder(ObjSubRepItem)
SizeKo = Round(FormatNumber(f.Size)/(1024),2) & " Ko" 'Taille en Ko avec 2 chiffres après la Virgule
SizeMo = Round(FormatNumber(f.Size)/(1048576),2) & " Mo"'Taille en Mo avec 2 chiffres après la Virgule
SizeGo = Round(FormatNumber(f.Size)/(1073741824),2) & " Go" 'Taille en Go avec 2 chiffres après la Virgule
 
If f.size < 1024 Then 
Fichier.WriteLine ("<tr><td><a href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</td><td>" & f.size & " Octet </a></td></tr>") 'Ecrire le path dans les lignes du Tableau en HTML
elseif f.size < 1048576 Then 
Fichier.WriteLine ("<tr><td><a href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</td><td>" & SizeKo & "</a></td></tr>") 'Ecrire le path dans les lignes du Tableau en HTML
elseif f.size < 1073741824 Then 
Fichier.WriteLine ("<tr><td><a href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</td><td>" & SizeMo & "</a></td></tr>") 'Ecrire le path dans les lignes du Tableau en HTML
else
Fichier.WriteLine ("<tr><td><a href='" & ObjSubRepItem.Path & "'>" & ObjSubRepItem.Path & "</td><td>" & SizeGo & "</a></td></tr>") 'Ecrire le path dans les lignes du Tableau en HTML
end if
 
ListerDossier ObjSubRepItem.Path, Fichier 'traiter les sous-dossiers
Next
ShellO.run "Liste.html"
End Function

21/11/2012, 11h26
elkhansa

Merci beaucoup pour le code, mais franchement je veux pas sous fichier.html avec des liens parce que je l'ai besoin pour une autre application .
C'est utile d'avoir la taille des fichiers aussi mais franchement je veux une script plus simple....
Merci et je vais essayer de le simplifier 8O

:salut:
Testez tout simplement ceci :

Code:

1
2
3
4
5
6
7
8
9
Dim ShellO: Set ShellO = CreateObject("WScript.Shell")
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim SListe: Dim Schemin
Schemin = InputBox("Entrez le chemin Absolu du dossier à lister "&vbCrlf&"Exemple c:\Program Files "&vbCrlf &_
"ou bien la Lettre du Lecteur exemple C:\ ou bien D:\","Dossiers et sous-dossiers","c:\")
If Schemin = "" Then WScript.Quit 
Command = "cmd /c dir /s /a /b "&Schemin&" > Liste.txt"
Resultat = ShellO.run(Command,0,True)
ShellO.run "Liste.txt"

21/11/2012, 14h02
elkhansa

Salut,

Merci pour votre aide :)