Lire le contenu de plusieurs repertoires

Version imprimable

11/10/2011, 15h36
Fiona08

Lire le contenu de plusieurs repertoires

Salut à tous,

je cherche un code pour lire le contenu de plusieur repertoires. Le chemin des repertoires sont sauvegardés
dans le fichier "repertoire.txt".

contenu du fichier repertoire.txt
D:\fichiersPDF_Societé_1
E:\fichierDoc_Societé_2

J'ai le code pour lire un seul repertoire. Comment le faire pour plusieurs?

Merci d'avance pour votre aide
Fiona

Citation:

Envoyé par Fiona08

Salut à tous,
je cherche un code pour lire le contenu de plusieur repertoires. Le chemin des repertoires sont sauvegardés
dans le fichier "repertoire.txt".
contenu du fichier repertoire.txt
D:\fichiersPDF_Societé_1
E:\fichierDoc_Societé_2
J'ai le code pour lire un seul repertoire. Comment le faire pour plusieurs?
Merci d'avance pour votre aide
Fiona

:salut:
inspire-toi de cette discussion.

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
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
End Function

Bonne Programmation :pc:

:salut:
Bon, j'ai un peu modifié ce script espérant qu'il vous donne un petit coup de pouce :ccool: ;)

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
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
Dim oFSO,oFld,oSubFolder,strFileSize,ws,NomFichierLog,temp,PathNomFichierLog,OutPut
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell")
Title = "Lister le contenu de plusieurs repertoires"
'pour le Comptage des fichiers
NbFichiers = 0 
NomFichierLog= "Fichiers_"& Day(Now)&"_"& Month(Now)&"_"& year(Now) &".txt"
NomFichierLogHTML= "Fichiers_"& Day(Now)&"_"& Month(Now)&"_"& year(Now) &".html"
temp = ws.ExpandEnvironmentStrings("%temp%")
PathNomFichierLog = temp & "\" & NomFichierLog
PathNomFichierLogHTML = temp & "\" & NomFichierLogHTML
Set OutPut = oFSO.OpenTextFile(temp & "\" & NomFichierLog,2,True)
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:\",Title,"c:\Program Files")
If Schemin = "" Then WScript.Quit 
If (myName = Winrep = oFSO.FolderExists(Schemin)) = False Then 
    Erreur = MsgBox("Le dossier "&qq(Schemin)&" est introuvable !",16,"Test d'existence du dossier" ) 
    Wscript.Quit 
End If 
OutPut.Writeline String(40,"*") & "Liste des Fichiers trouvés à cette date " &"(" & date & " à " & time & ")" & String(40,"*") & VbNewLine
ParcoursRep Schemin
OutPut.Writeline "Il y a "&Cstr(NbFichiers)& " Fichiers en total dans le dossier " &qq(Schemin)
OutPut.Close
Convert2HTML NomFichierLog,NomFichierLogHTML
 
If MsgBox ("Voulez-vous consulter le fichier journal : "& Vbcr & qq(NomFichierLog) &" en mode TEXTE ou bien en mode HTML ?" & Vbcr & Vbcr &_
"Pour Afficher en mode TEXTE Cliquer sur OUI "&Vbcr &_
"Pour Afficher en mode HTML Cliquer sur NON ",VbYesNo+VbQuestion ,Title ) = VbYes Then
Explorer(PathNomFichierLog)
else
Explorer(PathNomFichierLogHTML)
end if
 
Sub ParcoursRep (stRep )
On error resume next
    'MsgBox "On Traite le Répertoire : " & qq(stRep),64,qq(stRep)
	If oFSO.FolderExists(stRep) Then
	Set oFld = oFSO.GetFolder(stRep)
	end If
output.writeLine "Le Nom et le chemin du répertoire :" & qq(oFld.Path)  & " et il contient " & oFld.SubFolders.count & " sous-répertoires"
output.writeline String(120,"*")
 
For each File in oFld.Files
OutPut.WriteLine File.Path 
NbFichiers = NbFichiers + 1 
Next
output.writeLine "Il y a "& oFld.Files.count & " Fichiers dans le dossier "& qq(oFld.Path)
output.writeline String(120,"*")
 
	For each oSubFolder in oFld.subFolders
		ParcoursRep oSubFolder.Path 'appel récursif de la procédure
	Next
end sub
 
Function qq(strIn)
    qq = Chr(34) & strIn & Chr(34)
End Function
 
Function Explorer(File)
set ws = CreateObject("wscript.shell")
ws.Run "explorer "  & File,0,True
end Function
 
Function Convert2HTML(FileTxt,FileHTML)
Dim oFSO,ws,temp,OutPutHTML,StrHTML
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell")
temp = ws.ExpandEnvironmentStrings("%temp%")
Set ReadTxt = oFSO.OpenTextFile(temp & "\" & FileTxt,1)
Set OutPutHTML = oFSO.OpenTextFile(temp & "\" & FileHTML,2,True)
 strHTML="<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>"
StrHTML = StrHTML & "<center><B><font size=4 color=Red> Liste des Fichiers et des dossiers ! </font></B><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>"
StrHTML = StrHTML & ReadTxt.ReadALL
StrHTML = "<center>"& StrHTML &"</center>"
StrHTML = Replace(StrHTML,String(120,"*"),"<hr>")
StrHTML = Replace(StrHTML,VbCrlf,"<br>")
OutPutHTML.writeLine StrHTML
End Function

Salut hackoofr,

merci pour ta reponse. Mais elle est un peu compliqué pour moi.

Voilà ce que j'ai pu faire. et cela fonctionne bien. Ma question est de savoir comment reunir les deux boucle for en une seule(en mettant par exemple le nom du repertoire en paramettre?)

Merci d'avance
Fiona

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
Sub folderCheck()
 
    Dim input1, input2, targetType, fso, myFile, currentDate
 
    Set fso     = CreateObject("Scripting.FileSystemObject")
    input1       = "D:\Client1\Fp1" 
	input2      = "E:\Posting Files\Fp2"
 
	targetType = "pdf"
 
 
		currentDate = Date()
 
		'1er repertoire
		For Each myFile In fso.GetFolder(input1).Files 		 
			If LCase(fso.GetExtensionName(myFile.Name)) = LCase(targetType) Then
 
				If ( myFile.DateCreated < currentDate ) Then					
					WScript.echo myFile.Name & " " & myFile.DateCreated
					generateList 'appel d'une autre sub
				End If		
			End If
		Next
 
 
		'2eme repertoire
		For Each myFile In fso.GetFolder(input2).Files 
 
			If LCase(fso.GetExtensionName(myFile.Name)) = LCase(targetType) Then 
 
				If ( myFile.DateCreated < currentDate ) Then					
					WScript.echo myFile.Name & " " & myFile.DateCreated
					generateList 'appel d'une autre sub
				End If
			End If
		Next
 
end Sub

:salut:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Function folderCheck(Path_Folder,targetType)
    Dim  fso, myFile, currentDate
    Set fso = CreateObject("Scripting.FileSystemObject")
    currentDate = Date()
    Titre = "FolderCheck"
 
For Each myFile In fso.GetFolder(Path_Folder).Files          
    If LCase(fso.GetExtensionName(myFile.Name)) = LCase(targetType) Then
 
        If ( myFile.DateCreated < currentDate ) Then                    
            MsgBox "Fichier : " & myFile.Name & " et a été crée le :" & myFile.DateCreated,64,Titre
                'generateList 'appel d'une autre sub 
 
        End If        
    End If
Next
end Function
'appel de la fonction en passant 2 paramétres le chemin du dossier et l'extension à rechercher
Call folderCheck("D:\Client1\Fp1","pdf")
Call folderCheck("E:\Posting Files\Fp2","pdf")

13/10/2011, 16h49
Fiona08

Merci hackoofr,

ca fonctionne bien.

Bye
Fiona