SUPPRIME FICHIERS DATANT DE PLUS DE 15 JOURS !!!!

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