Discussion :

[klef63]

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 :

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

[klef63]

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 :

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

[hackoofr]

Bonjour,
Voila essaye ce

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

[klef63]

Merci impeccable !!

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

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 :

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

[hackoofr]

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 :

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

[klef63]

Super !!!
Merci beaucoup pour ton aide le script fonctionne parfaitement
Bonne journée !

[beta1204]

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 :

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

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

merci

[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

[beta1204]

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

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[l_autodidacte]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[beta1204]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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é !!