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