Supprime fichiers datant de plus de 15 jours !!!!

Contenu du snippet

Se script en VBS vous permet de suuprimer les fichiers datant de plus de 15 jours vous pouvez bien evidemment Changer se parametre.Lorsque vous le lancer une boite de dialogue apparait pour vous demander de choisir les dossier a explorer pour supprimer les fichiers en question.Il permet d explorer le sous dossier egalement!

J espere qu il sera utile et dite moi ce que vous en pensez et si vous trouvez des ameliorations

Source / Exemple :


'*******************************************************************************
' Script permettant D 'effacer les fichiers Qui date de plus de 15 jours
' Avec interface Graphique
'
'*******************************************************************************

strComputer = "."

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")		
Set objFolder = objShell.BrowseForFolder _
    (WINDOW_HANDLE, "Selectionner le dossier à traiter :", NO_OPTIONS, ".")
Set objFolderItem = objFolder.Self
strFolderName = objFolderItem.Path

Set colSubfolders = objWMIService.ExecQuery _
    ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
        & "Where AssocClass = Win32_Subdirectory " _
            & "ResultRole = PartComponent")

'Wscript.Echo strFolderName

arrFolderPath = Split(strFolderName, "\")
strNewPath = ""
For i = 1 to Ubound(arrFolderPath)
    strNewPath = strNewPath & "\\" & arrFolderPath(i)
Next
strPath = strNewPath & "\\"

Set colFiles = objWMIService.ExecQuery _
    ("Select * from CIM_DataFile where Path = '" & strPath & "'")

For Each objFile in colFiles
    Set objReadOnlyFile = objFSO.GetFile(objFile.Name)
     'Wscript.Echo objFile.Name & chr (10) &  objReadOnlyFile.DateLastModified
 if DateDiff("d",objReadOnlyFile.DateLastModified ,Date)>15 then

     objFile.delete
end if
Next

For Each objFolder in colSubfolders
    GetSubFolders strFolderName
Next

Sub GetSubFolders(strFolderName)
    Set colSubfolders2 = objWMIService.ExecQuery _
        ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
            & "Where AssocClass = Win32_Subdirectory " _
                & "ResultRole = PartComponent")

    For Each objFolder2 in colSubfolders2
        strFolderName = objFolder2.Name
        'Wscript.Echo
        'Wscript.Echo objFolder2.Name
        arrFolderPath = Split(strFolderName, "\")
        strNewPath = ""
        For i = 1 to Ubound(arrFolderPath)
            strNewPath = strNewPath & "\\" & arrFolderPath(i)
        Next
        strPath = strNewPath & "\\"

        Set colFiles = objWMIService.ExecQuery _
            ("Select * from CIM_DataFile where Path = '" & strPath & "'")

        For Each objFile in colFiles
        Set objReadOnlyFile = objFSO.GetFile(objFile.Name)
        if DateDiff("d",objReadOnlyFile.DateLastModified ,Date)>15 then
            'Wscript.Echo objFile.Name & chr (10) &  objReadOnlyFile.DateLastModified
            objFile.delete

          end if

        Next

        GetSubFolders strFolderName
    Next
End Sub

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.