Suppression de fichiers plus vieux de x jours (vbs)

Version imprimable

Bonjour,

J'essaye de créer un vbs pour supprimer des fichiers plus anciens que 100 jours par exemple, dans un dossier.
J'ai trouvé sur le net un script qui le fait très bien et fonctionne parfaitement.
Par contre cela fonctionne uniquement pour les fichiers dans le dossier selectionné, pas dans les sous-dossiers.

J'aimerais que le script passe dans tout le répertoire et sous repertoires, pour faire l'opération de suppression sur tous les fichiers.
J'aimerais aussi qu'un fichier log soit créé avec le listing des fichiers qui ont été supprimés.
Je débute en vbs et ne sait pas du tout comment m'y prendre.

Voici le script :
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 '************************** 'Declarations de variables '************************** 'Repertoire ou sont stockees les fichiers DossierTestAncienFichiers = "D:\test_del_anciens_fichiers" 'Nombre de jours de conservation des Fichiers AgeMaximalFichiers = 100 'Initialisation des objets Set fso = CreateObject("Scripting.FileSystemObject") 'On verifie que le repertoire existe If (myName = Winrep = fso.FolderExists(DossierTestAncienFichiers)) = False Then Erreur = MsgBox("Le Répertoire est introuvable !" ) Wscript.Quit End If 'On recupere la date système DateSysteme = Date '************************************** 'Suppression des fichiers trop anciens '************************************** Set Folder = fso.Getfolder(DossierTestAncienFichiers) For Each File In Folder.Files If (DateDiff("d", File.DateCreated, DateSysteme) > AgeMaximalFichiers) Then If File.Attributes And 1 Then File.Attributes = File.Attributes - 1 File.Delete() End If Next
Merci d'avance pour vos réponses

J'ai trouvé une partie de ma demande.
Maintenant j'ai un script qui supprime bien les fichiers dans les sous dossiers.

Il me manque juste une fonction de création de fichier log, avec un choix de destination de ce fichier log.
Ce fichier log doit contenir tout le déroulement du script pour analyser ce qu'il fait, et avec les différents fichiers effacés.
Je fait des recherches mais je sèche un peu...

Voici le code qui fonctionne avec les 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
'Les declarations 
 
 
'Repertoire ou sont stockes les fichiers 
DossierSauvegarde = "D:\test_del_anciens_fichiers" 
 
'Nombre de jours de conservation des Fichiers 
AgeMaximalFichiers = "100" 
 
'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 systeme 
DateSysteme = Date 
 
'On apelle la fonction d'effacement 
 
Clean(DossierSauvegarde) 
 
 
'Fonction d'effacement des fichiers 
Sub Clean(FolderPath) 
 
Set Folder = fso.Getfolder(FolderPath) 
 
'On appelle recursivement la fonction s'il y a des sous dossiers 
 
Set SubFolder = Folder.SubFolders 
   For Each CurrentFolder in SubFolder 
      Clean CurrentFolder.Path 
   Next 
 
'On efface les fichiers dans le dossier courant 
 
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 
End Sub 
 
 
 
 
'On affiche un joli message 
MsgBox (Cstr(NbFichiersEffaces) + " fichiers ont ete effaces" )

Bonjour,
Voila essaye ce

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
 
'Repertoire ou sont stockes les fichiers 
DossierSauvegarde = "D:\test_del_anciens_fichiers" 
 
'Nombre de jours de conservation des Fichiers 
AgeMaximalFichiers = "100" 
 
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
 
'Initialisation des objets 
Set fso = CreateObject("Scripting.FileSystemObject" ) 
Set OutPut = fso.CreateTextFile("Supprimer_Log.txt",1)  
'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 systeme 
DateSysteme = Date 
 
'On apelle la fonction d'effacement 
 
Clean(DossierSauvegarde) 
 
 
'Fonction d'effacement des fichiers 
Sub Clean(FolderPath) 
 
Set Folder = fso.Getfolder(FolderPath) 
 
'On appelle recursivement la fonction s'il y a des sous dossiers 
 
Set SubFolder = Folder.SubFolders 
   For Each CurrentFolder in SubFolder 
      Clean CurrentFolder.Path 
   Next 
 
'On efface les fichiers dans le dossier courant 
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 
	OutPut.WriteLine File.Path 'Ecrire  le chemin du Fichier Supprimé
MsgBox "Le Fichier  " & File.Path & "  va être supprimé ",64,"Suppression des fichiers trop anciens"
            File.Delete() 
            NbFichiersEffaces = NbFichiersEffaces + 1 
        End If 
Next 
End Sub 
 
'On affiche un joli message 
MsgBox (Cstr(NbFichiersEffaces) + " fichiers ont ete effaces" )
 
Set objShell = CreateObject("WScript.Shell")
 objShell.run ("Explorer Supprimer_Log.txt" )

Merci impeccable !!

Par contre j'ai toujours pas fini je vais être chiant :mouarf:

En fait je n'ai pas besoin d'avoir une confirmation, ni d'avoir le fichier log qui s'affiche directement à l'écran, je veux juste avoir le log.
Donc j'ai modifié le script en conséquense :

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
 
'Repertoire ou sont stockes les fichiers 
DossierSauvegarde = "D:\test_del_anciens_fichiers" 
 
'Nombre de jours de conservation des Fichiers 
AgeMaximalFichiers = "100" 
 
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
 
'Initialisation des objets 
Set fso = CreateObject("Scripting.FileSystemObject" ) 
Set OutPut = fso.CreateTextFile("Supprimer_Log.txt",1)  
'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 systeme 
DateSysteme = Date 
 
'On apelle la fonction d'effacement 
 
Clean(DossierSauvegarde) 
 
 
'Fonction d'effacement des fichiers 
Sub Clean(FolderPath) 
 
Set Folder = fso.Getfolder(FolderPath) 
 
'On appelle recursivement la fonction s'il y a des sous dossiers 
 
Set SubFolder = Folder.SubFolders 
   For Each CurrentFolder in SubFolder 
      Clean CurrentFolder.Path 
   Next 
 
'On efface les fichiers dans le dossier courant 
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 
	OutPut.WriteLine File.Path 'Ecrire  le chemin du Fichier Supprimé
            File.Delete() 
            NbFichiersEffaces = NbFichiersEffaces + 1 
        End If 
Next 
End Sub

Je n'ai pas besoin de la message box qui affiche le nombre de fichiers
supprimés, je l'ai donc enlevée
Par contre j'aimerais que ce nombre s'affiche à la fin du fichier log, si possible avec un retour comme quoi le script s'est bien exécuté.
Et aussi qu'a chaque exécution du script, ca créer un nouveau fichier log, que ca incrémente de 1 à chaque fois.
Ex : log_01.txt puis log_02.txt ...
J'essaye de trouver mais c'est dur vu que j'y connais rien !

Citation:

Envoyé par klef63

Merci impeccable !!
Je n'ai pas besoin de la message box qui affiche le nombre de fichiers
supprimés, je l'ai donc enlevée
Par contre j'aimerais que ce nombre s'affiche à la fin du fichier log, si possible avec un retour comme quoi le script s'est bien exécuté.
Et aussi qu'a chaque exécution du script, ca créer un nouveau fichier log, que ca incrémente de 1 à chaque fois.
Ex : log_01.txt puis log_02.txt ...
J'essaye de trouver mais c'est dur vu que j'y connais rien !

il est plus simple d'utiliser La création du fichier Log suivant la date système comme par exemple : LogFile_21_12_2010, LogFile_22_12_2010 etc....

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
'Repertoire ou sont stockes les fichiers 
DossierSauvegarde = "D:\test_del_anciens_fichiers" 
 
'Nombre de jours de conservation des Fichiers 
AgeMaximalFichiers = "100" 
 
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
'Nom du Fichier  Log  suivant  La Date  systeme
LogFile_Date = "LogFile_" & Day(Now) & "_" & Month(Now) & "_" & Year(Now)
'Initialisation des objets 
Set fso = CreateObject("Scripting.FileSystemObject" )
if not fso.fileExists(LogFile_Date & ".txt") Then
Set OutPut = fso.CreateTextFile(LogFile_Date & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "Nous sommes Le " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " La liste des Fichiers Supprimés a cette heure " & Time & " est :"  
OutPut.WriteLine "*************************************************************************************************"
else
Set OutPut = fso.OpenTextFile(LogFile_Date & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "Nous sommes Le " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " La liste des Fichiers Supprimés a cette heure " & Time & " est :" 
OutPut.WriteLine "*************************************************************************************************"
end if
'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 systeme 
DateSysteme = Date 
 
'On apelle la fonction d'effacement 
 
Clean(DossierSauvegarde) 
 
 
'Fonction d'effacement des fichiers 
Sub Clean(FolderPath) 
 
Set Folder = fso.Getfolder(FolderPath) 
 
'On appelle recursivement la fonction s'il y a des sous dossiers 
 
Set SubFolder = Folder.SubFolders 
   For Each CurrentFolder in SubFolder 
      Clean CurrentFolder.Path 
   Next 
 
'On efface les fichiers dans le dossier courant 
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 
 
	OutPut.WriteLine File.Path 'Ecrire  le chemin du Fichier Supprimé
            File.Delete() 
            NbFichiersEffaces = NbFichiersEffaces + 1 
        End If 
Next 
End Sub
OutPut.WriteLine Cstr(NbFichiersEffaces) + " Fichiers ont été Supprimés !"
OutPut.WriteLine "*************************************************************************************************"
'MsgBox Cstr(NbFichiersEffaces) + " Fichiers ont été Supprimés !",64," Les Fichiers Supprimés"

22/12/2010, 09h30
klef63

Super !!! :ccool:
Merci beaucoup pour ton aide le script fonctionne parfaitement :hola::merci:
Bonne journée !

Bonjour,

Je me permets de déterrer ce sujet car le script correspond à une grosse partie de mon besoin.

Je souhaiterais pouvoir également supprimer les sous-dossiers lorsqu'ils sont vides.

J'ai donc trouvé un script (script removal_folder.vbs) qui correspond à ça.

J'ai donc couplet les deux scripts après avoir supprimé "Option Explicit" qui me posait problème.

Voici le script maintenant :

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
95
'Repertoire ou sont stockes les fichiers 
DossierSauvegarde = "D:\test\Maintenance" 
 
'Nombre de jours de conservation des Fichiers 
AgeMaximalFichiers = "7" 
 
'Comptage des fichiers effaces 
NbFichiersEffaces = 0 
'Nom du Fichier  Log  suivant  La Date  systeme
LogFile_Date = "FichierLog_" & Day(Now) & "_" & Month(Now) & "_" & Year(Now)
'Initialisation des objets 
Set fso = CreateObject("Scripting.FileSystemObject" )
if not fso.fileExists("D:\delage\folder\logs\" & LogFile_Date & ".txt") Then
Set OutPut = fso.CreateTextFile("D:\delage\folder\logs\" & LogFile_Date & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "Nous sommes Le " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " La liste des Fichiers Supprimés a cette heure " & Time & " est :"  
OutPut.WriteLine "*************************************************************************************************"
else
Set OutPut = fso.OpenTextFile("D:\delage\folder\logs\" & LogFile_Date & ".txt",8)
OutPut.WriteLine "*************************************************************************************************"
OutPut.WriteLine "Nous sommes Le " &  Day(Now) & "/" & Month(Now) & "/" & Year(Now)& " La liste des Fichiers Supprimés a cette heure " & Time & " est :" 
OutPut.WriteLine "*************************************************************************************************"
end if
'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 systeme 
DateSysteme = Date 
 
'On apelle la fonction d'effacement 
 
Clean(DossierSauvegarde) 
 
 
'Fonction d'effacement des fichiers 
Sub Clean(FolderPath) 
 
Set Folder = fso.Getfolder(FolderPath) 
 
'On appelle recursivement la fonction s'il y a des sous dossiers 
 
Set SubFolder = Folder.SubFolders 
   For Each CurrentFolder in SubFolder 
      Clean CurrentFolder.Path 
   Next 
 
'On efface les fichiers dans le dossier courant 
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 
 
	OutPut.WriteLine File.Path 'Ecrire  le chemin du Fichier Supprimé
            File.Delete() 
            NbFichiersEffaces = NbFichiersEffaces + 1 
        End If 
Next 
End Sub
 
 'On efface les dossiers et sous-dossiers vides
 Const pfad = ("D:\test\Maintenance")
 
Dim Text, Title, index, Txt()
Dim fso, wsh, i
 
index = 1
 
Set wsh = WScript.CreateObject ("WScript.Shell")
 
Set fso = WScript.CreateObject("Scripting.FileSystemObject") 
 
RecFolder index, wsh.ExpandEnvironmentStrings(pfad) 
 
Function RecFolder (idx, pfad) 
 
Dim fo, fc, i, colFiles, file 
 
Set fo = fso.GetFolder(pfad) 
Set fc = fo.SubFolders
Set colFiles = fo.Files
 
For Each i in fc 
Call RecFolder (idx+1, pfad + "\" + i.name) 
 
If i.Files.Count = 0 And i.SubFolders.Count = 0 Then 
fso.DeleteFolder(pfad + "\" + i.name)
End if
Next
End function
 
OutPut.WriteLine Cstr(NbFichiersEffaces) + " Fichiers ont été Supprimés !"
OutPut.WriteLine "*************************************************************************************************"

Est-il possible dans le fichier log créé de rajouter les sous-dossiers vides qui sont supprimer ?
Je débute également en VBS et j'ai donc encore des difficultés.

PS: Ce script sera utilisé dans plusieurs dossiers en suivant cette arborescence:
\\serveur\dossier\dossier\dossier\Dossier_de_sauvegardes1
\\serveur\dossier\dossier\dossier\Dossier_de_sauvegardes2
\\serveur\dossier\dossier\dossier\Dossier_de_sauvegardes3
\\serveur\dossier\dossier\dossier\Dossier_de_sauvegardes4
\\serveur\dossier\dossier\dossier\Dossier_de_sauvegardes5
\\serveur\dossier\dossier\dossier\Dossier_de_sauvegardes6
\\serveur\dossier\dossier\dossier\Dossier_de_sauvegardes7
\\serveur\dossier\dossier\dossier\Dossier_de_sauvegardes8

Est-il possible de faire une boucle dans le script avec ces différents dossiers ou est-il préférable de faire un VBS par dossier et de les exécuter à partir d'un VBS central ?

Merci beaucoup ;)

13/03/2013, 11h34
beta1204
Pour l'histoire du nettoyage dans les différents dossiers, je pense créer des VBS séparé pour chaque dossier et ensuite les lancer avec un batch de ce style:
Code:

1 2 3 cscript.exe "D:\delage\folder\test1.vbs" cscript.exe "D:\delage\folder\test2.vbs"
Par contre je cherche toujours à rajouter dans le fichier log créé les sous-dossiers vides qui sont supprimés.
Si vous avez des idées je suis preneur :ccool:

merci
13/03/2013, 13h09
l_autodidacte

Entre les lignes 46 et 47 ajoute If CurrentFolder.Size = 0 Then OutPut.WriteLine CurrentFolder.Path & " (Dossier vide)" juste avant de le vider
13/03/2013, 13h58
beta1204
Citation:

Envoyé par l_autodidacte

Entre les lignes 46 et 47 ajoute If CurrentFolder.Size = 0 Then OutPut.WriteLine CurrentFolder.Path & " (Dossier vide)" juste avant de le vider

Merci pour ton retour ça fonctionne :ccool:

J'ai rajouté le End IF à la fin et le comptage des dossiersen plus.
Le code divient donc:
Code:

1 2 3 4 5 If CurrentFolder.Size = 0 Then OutPut.WriteLine CurrentFolder.Path & " (Dossier vide)" NbDossiersEffaces = NbDossiersEffaces + 1 End If
Donc juste pour bien comprendre le principe, ce petit bout de code permet simplement d'identifier les dossiers et sous-dossiers vides et de les marquer dans le log comme supprimé.
C'est après avec la suite du code pour supprimer les dossiers qu'ils sont réellement supprimés ?
Est-il possible d'avoir une vérification que les dossiers sont réellement supprimés ? Puisque si par exemple il y a un problème de droit ou d'attribut sur le dossier et qu'il ne puisse pas être supprimé, il sera marqué quand même comme supprimé dans le log.

Merci

Code:

1
2
3
4
5
6
7
8
9
 
   If CurrentFolder.Size = 0 Then
     OutPut.WriteLine CurrentFolder.Path & " (Dossier vide)"
     NbDossiersEffaces = NbDossiersEffaces + 1
 
     If Err.Number = 70 Then ' Si permission refusée
         OutPut.WriteLine CurrentFolder.Path & " (Permission de suppression refusée)"
     End If
   End If

Citation:

Envoyé par l_autodidacte

Code:

1
2
3
4
5
6
7
8
9
 
   If CurrentFolder.Size = 0 Then
     OutPut.WriteLine CurrentFolder.Path & " (Dossier vide)"
     NbDossiersEffaces = NbDossiersEffaces + 1
 
     If Err.Number = 70 Then ' Si permission refusée
         OutPut.WriteLine CurrentFolder.Path & " (Permission de suppression refusée)"
     End If
   End If

Veuillez m'excuser de ce retard, j'étais parti sur autre chose et je n'avais pas vu votre réponse.
Merci, script modifié !!