MS VBS : Script effacement Fichiers sous dossiers plus vieux que X Jours avec Génération d'un fichier de Log

Bonjour,

Nouveau sur le forum, tout débutant en MS VbScript, j'avais besoin d'un script pour effacer le contenu de dossiers de partage ou dossiers de sauvegardes plus vieux de X jours avec la génération d'un logFile.
Il me sert à nettoyer des répertoires de sauvegardes et des dossier d'échange entre utilisateurs, cela m'évite un passage fastidieux sur les serveurs et préserve l'espace disque.
Je me suis grassement inspiré de plusieurs script proposés ici (grand merci pour ce forum), pour faire le script dont je rêvais.

Je vous le livre donc a toute fin utile :

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
  ' VB Script Document
 
 
'Effacement sauvegardes srv-tse
'Repertoire ou sont stockes les fichiers
DossierPartage = "D:\Non_save\Transfert_NS" 
 
'Nombre de jours de conservation des Fichiers
AgeMaximalFichiers = "15" 
 
'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(DossierPartage & "\" & LogFile_Date & ".txt") Then
Set OutPut = fso.CreateTextFile(DossierPartage & "\" & 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(DossierPartage & "\" & 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 Partage existe
If (myName = Winrep = fso.FolderExists(DossierPartage)) = False Then
    Erreur = MsgBox("Le dossier de partage est introuvable !" )
    Wscript.Quit
End If
 
'On recupere la date systeme
DateSysteme = Date 
 
'On apelle la fonction d'effacement 
Clean(DossierPartage)
 
OutPut.WriteLine Cstr(NbFichiersEffaces) + " Fichiers ont été Supprimés !"
OutPut.WriteLine "*************************************************************************************************"
 
'------------------------------------------------- 
'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
    If CurrentFolder.Files.Count = 0 Then
      fso.DeleteFolder(CurrentFolder)
    End If
  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