Supprimer dans les sous dossiers

**labusette** · 22/08/2011, 15h36

Bonjour,

Nous avons un script vbs, qui nous sert a supprimmer des fichiers obsolètes dans un dossier. Il fonctionne tres bien mais uniquement dans le dossier spécifié et nous aurions besoin de le modifier pour que les sous dossier soit egalement analysé.
Voici ci dessous mon script, pouvez vous me dire ce que je dois modifier ?
Merci pour votre aide.

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
 
'Les declarations  
 
'Repertoire ou sont stockes les fichiers 
DossierSauvegarde = "D:\Scanner\" 
 
'Nombre de jours de conservation des Fichiers 
AgeMaximalFichiers = "8" 
 
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
 
'Initialisation des objets 
Set fso = CreateObject("Scripting.FileSystemObject" ) 
 
'On verifie que le repertoire de sauvegarde existe 
If (myName = Winrep = fso.FolderExists(DossierSauvegarde)) = False Then 
    Erreur = MsgBox("Le dossier de sauvegarde est introuvable !" ) 
    Wscript.Quit 
End If 
 
'On recupere la date système 
DateSysteme = Date 
 
'Suppression des fichiers trop anciens 
 
Set Folder = fso.Getfolder(DossierSauvegarde) 
For Each File In Folder.Files 
        If (DateDiff("d", File.DateLastModified, DateSysteme) > CInt(AgeMaximalFichiers)) Then 
            'On verifie qu'ils ne sont pas en lecture seule 
            If File.Attributes And 1 Then File.Attributes = File.Attributes - 1 
            File.Delete() 
            NbFichiersEffaces = NbFichiersEffaces + 1 
        End If 
Next 
 
'On affiche un joli message 
MsgBox (Cstr(NbFichiersEffaces) + " fichiers ont ete effaces" )

**SfJ5Rpw8** · 22/08/2011, 16h04

Voici un code pouvant te servir de modèle :

Fonction récursive de parcours d'un répertoire

**l_autodidacte** · 22/08/2011, 22h53

Très bien vu bbil, rien à dire après tes propos.
Néanmoins, d'après ce que j'ai pu comprendre des propos de labusette, je pense qu'il lui est un peu difficile d'adapter cette fonction à ses besoins.
Je pense que son code modifié servirait son attente

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
'Les declarations  
'Repertoire ou sont stockes les fichiers 
DossierSauvegarde = "D:\Scanner\" 
'Nombre de jours de conservation des Fichiers 
AgeMaximalFichiers = "8" 
 
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
 
'Initialisation des objets 
Set fso = CreateObject("Scripting.FileSystemObject" ) 
 
'On verifie que le repertoire de sauvegarde existe 
If (myName = Winrep = fso.FolderExists(DossierSauvegarde)) = False Then 
    Erreur = MsgBox("Le dossier de sauvegarde est introuvable !" ) 
    Wscript.Quit 
End If 
 
'On recupere la date système 
DateSysteme = Date 
 
'Suppression des fichiers trop anciens 
 Set Folder = fso.Getfolder(DossierSauvegarde) 
 For Each File In Folder.Files 
        If (DateDiff("d", File.DateLastModified, DateSysteme) > CInt(AgeMaximalFichiers)) Then 
            'On verifie qu'ils ne sont pas en lecture seule 
            If File.Attributes And 1 Then File.Attributes = File.Attributes - 1 
            File.Delete() 
            NbFichiersEffaces = NbFichiersEffaces + 1 
        End If 
Next 
 
For Each sbFold In Folder.Subfolders
    For Each File In sbFold.Files 
        If (DateDiff("d", File.DateLastModified, DateSysteme) > CInt(AgeMaximalFichiers)) Then 
            'On verifie qu'ils ne sont pas en lecture seule 
            If File.Attributes And 1 Then File.Attributes = File.Attributes - 1 
            File.Delete() 
            NbFichiersEffaces = NbFichiersEffaces + 1 
        End If 
	Next	
Next 
 Dim Ret
 If NbFichiersEffaces <= 1 Then 
    Ret = Cstr(NbFichiersEffaces) & " fichier a été effacé"
 Else 
    Ret = Cstr(NbFichiersEffaces) &  " fichiers ont été effacés"
 End If
'On affiche un joli message 
MsgBox Ret

Mais si je me trompais sur ses connaissances en vbs !!!

**labusette** · 23/08/2011, 09h51

Merci beaucoups à tous les 2 pour vos réponses.
Je pourrais tester demain les modifications apportés par "l_autodidacte".
C'est plus que ce que j'esperais

**hackoofr** · 23/08/2011, 22h10

Voici un autre code que vous pouvez aussi ajouté un système de journalisation : "LogFile" comme bonus

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
Dim DossierSauvegarde 'Nom du répertoire à parcourir
Dim oFSO,oFld,oSubFolder,strFileSize,ws,NomFichierLog,temp,PathNomFichierLog,OutPut
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell" )
Title = "Suppression des Fichiers"
'Nombre de jours de conservation des Fichiers 
AgeMaximalFichiers = "8" 
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
NomFichierLog= "Fichiers Supprimés_"& Day(Now)&"_"& Month(Now)&"_"& year(Now) &".txt"
temp = ws.ExpandEnvironmentStrings("%temp%")
PathNomFichierLog = temp & "\" & NomFichierLog
Set OutPut = oFSO.OpenTextFile(temp & "\" & NomFichierLog,2,True)
DossierSauvegarde = "D:\Scanner\"
'On verifie que le repertoire de sauvegarde existe 
If (myName = Winrep = oFSO.FolderExists(DossierSauvegarde)) = False Then 
    Erreur = MsgBox("Le dossier de sauvegarde est introuvable !",16,"Test d'existence du dossier" ) 
    Wscript.Quit 
End If 
 
'On recupere la date système 
DateSysteme = Date
ParcoursRep DossierSauvegarde
wscript.sleep 3000
If MsgBox ("Voulez-vous consulter le fichier journal : " & qq(NomFichierLog),VbYesNo+VbQuestion ,Title ) = VbYes Then
Explorer(PathNomFichierLog)
else
wscript.quit
end if
 
Sub ParcoursRep (stRep )
    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(100,"*")
 
For each File in oFld.Files
If (DateDiff("d", File.DateLastModified, DateSysteme) > CInt(AgeMaximalFichiers)) Then 
'On verifie qu'ils ne sont pas en lecture seule 
If File.Attributes And 1 Then File.Attributes = File.Attributes - 1
OutPut.WriteLine File.Path 
'Msgbox File.Path,64,File.Path
File.Delete()
NbFichiersEffaces = NbFichiersEffaces + 1 
End If 
Next
output.writeLine "Il y a "& oFld.Files.count & " Fichiers dans le dossier "& qq(oFld.Path)  
output.writeline String(100,"*")
 
	For each oSubFolder in oFld.subFolders
		ParcoursRep oSubFolder.Path 'appel récursif de la procédure
	Next
end sub
 
OutPut.Writeline Cstr(NbFichiersEffaces) + " fichiers ont été supprimés !"
MsgBox (Cstr(NbFichiersEffaces) + " fichiers ont été supprimés !" ),64,Cstr(NbFichiersEffaces) + " fichiers ont été effacés"
 
Function qq(strIn)
    qq = Chr(34) & strIn & Chr(34)
End Function
 
Function Explorer(File)
    Set ws=CreateObject("wscript.shell")
    ws.run "Explorer.exe "& File & "\",0,True
end Function

**labusette** · 24/08/2011, 09h36

Merci beaucoups c'est parfait

**hackoofr** · 24/08/2011, 15h20

Bon j'ai toujours une tendance à transformer mes LogFile en mode HTML.

Je ne sais pas pourquoi peut-être une question d’esthétique ou bien d'une meilleur lisibilité

Donc j'ai ajouté une fonction Convert2HTML(FileTxt,FileHTML) pour convertir le Fichier Texte en Fichier HTML et bien sûr ça restera une question de choix donc c'est facultatif mais je vous assure que c'était un bon exercice pour moi et j’espère pour toi aussi

Bonne Programmation

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
Dim DossierSauvegarde 'Nom du répertoire à parcourir
Dim oFSO,oFld,oSubFolder,strFileSize,ws,NomFichierLog,temp,PathNomFichierLog,OutPut
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell")
Title = "Suppression des Fichiers"
'Nombre de jours de conservation des Fichiers 
AgeMaximalFichiers = "8" 
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
'On recupere la date système 
DateSysteme = Date
NomFichierLog= "Fichiers Supprimés_"& Day(Now)&"_"& Month(Now)&"_"& year(Now) &".txt"
NomFichierLogHTML= "Fichiers Supprimés_"& 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)
DossierSauvegarde = "D:\Scanner\"
'On verifie si le repertoire de sauvegarde existe 
'explorer DossierSauvegarde
 
If (myName = Winrep = oFSO.FolderExists(DossierSauvegarde)) = False Then 
    Erreur = MsgBox("Le dossier de sauvegarde est introuvable !",16,"Test d'existence du dossier" ) 
    Wscript.Quit 
End If 
OutPut.Writeline String(40,"*") & "Liste des Fichiers qui ont été supprimés le " &"(" & date & " à " & time & ")" & String(40,"*") & VbNewLine
ParcoursRep DossierSauvegarde
OutPut.Writeline Cstr(NbFichiersEffaces) + " fichiers ont été supprimés avec succés !"
MsgBox (Cstr(NbFichiersEffaces) + " fichiers ont été supprimés avec succés !" ),64,Cstr(NbFichiersEffaces) + " fichiers ont été supprimés avec succés !"
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 )
    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
If (DateDiff("d", File.DateLastModified, DateSysteme) > CInt(AgeMaximalFichiers)) Then 
'On verifie qu'ils ne sont pas en lecture seule 
If File.Attributes And 1 Then File.Attributes = File.Attributes - 1
OutPut.WriteLine File.Path & " a été supprimé avec succés !"
'Msgbox File.Path,64,File.Path
File.Delete()
NbFichiersEffaces = NbFichiersEffaces + 1 
End If 
Next
output.writeLine "Il y a "& oFld.Files.count & " Fichiers dans le dossier "& qq(oFld.Path) &_
"et "& Cstr(NbFichiersEffaces) & " Fichiers qui ont été supprimés !"
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><font size=4 color=Red> Liste des Fichiers qui ont été Supprimés ! </font><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

**hackoofr** · 26/08/2011, 18h58

Envoyé par labusette

Merci beaucoups c'est parfait

si c'est parfait alors il vous manque juste un petit clique sur

**labusette** · 12/09/2011, 09h10

Merci encore pour vos réponses, j'ose juste encore une dernière petite question concernant ce script. Si je souhaite analyser seulement un type de fichier, uniquement les extensions .pdf par exemple, que dois je ajouter ?

**hackoofr** · 12/09/2011, 09h51

Envoyé par labusette

Merci encore pour vos réponses, j'ose juste encore une dernière petite question concernant ce script. Si je souhaite analyser seulement un type de fichier, uniquement les extensions .pdf par exemple, que dois je ajouter ?

oui tu peut oser

mais à condition tu vote pour le code et tu mets le sujet en

Ehh oui car pour chaque Question = Nouvelle Discussion
Tu poses alors la question suivante dans une nouvelle discussion avec par exemple ce titre: Comment faire pour scanner et supprimer uniquement les extensions .pdf ?
Bonne Programmation

**labusette** · 12/09/2011, 10h01

Entendu

Merci

Supprimer dans les sous dossiers

VBScript

Discussions similaires

Partager

Partager