Citation :
Option Explicit
Const NbJours = 30 '30 jours maxi
dim Repertoire, objShell, objFolder, fso, d, subdir, sf, f1, sd, suppmess
'Utilisation d'un browser pour aller chercher le repertoire parent
Set objShell = CreateObject("Shell.Application" )
Set objFolder = objShell.BrowseForFolder(0, "Archivage", 0, "MON CHEMIN" )
If (not objFolder is nothing ) then
Set fso = WScript.CreateObject("Scripting.FileSystemObject" )
'Vérifier que le répertoire existe et lister le contenu de celui ci et de ses sous répertoires
If fso.FolderExists (objFolder) Then 'Si le Repertoire recherché par browser existe alors
Set d = fso.GetFolder(objFolder) 'Acceder au repertoire par la variable d
Set sf = d.Files
For Each f1 in sf
Next
Set sd = d.SubFolders
For Each subdir in sd 'pour chaque sous répertoire dans fld
If fso.FolderExists (subdir) Then
Set d = fso.GetFolder(subdir)
Set sf = d.Files
Dim WShShell, BtnCode
Set WShShell = WScript.CreateObject("WScript.Shell" )
BtnCode = WShShell.Popup("Etes vous sur de vouloir supprimer les fichiers du repertoire" & vbCrLf & subdir & " ?", 0, "WARNING", 4 + 16)
suppmess = ""
For Each f1 in sf
'Comparaison de la et deleter les fichiers en trop vieux
If DateDiff("d", f1.DateLastModified, Now) > NbJours Then
Select Case BtnCode
case 6
suppmess = suppmess & " - " & f1 & vbCrLf
f1.Delete
case 7
WScript.Echo "Annulation de la suppréssion"
WScript.Quit
case -1 WScript.Echo "Erreur de Script"
WScript.Quit
End Select
End If
Next
WScript.Echo "Les fichiers : " & vbCrLf & suppmess & vbCrLf & "ont été supprimés avec succes"
Else
WScript.Echo "Le sous repertoire " & subdir & " n'existe pas"
End If
Next
Else
WScript.Echo "Le repertoire " & objFolder & " n'existe pas"
End If
End if
WScript.Quit
|