Dim strComputer, strPath, Debug
strComputer = "."
strDrive = "D:"
strPath = "\\Mes scripts VBFrance\\Test\\"
Debug=True 'Debug=True pour afficher les msgbox, les fichiers ne seront pas supprimés
'Debug=False pas de msgbox, les fichiers seront supprimés
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery _
("Select * From CIM_DataFile Where Drive = '" & strDrive & "'" & "And Path = '" & strPath & "'")
If colFiles.Count <> 0 Then
For Each objFile in colFiles
dtDiffFile = DateDiff("d", Now, fnConversionDate(objFile.LastModified))
If dtDiffFile =< -7 Then ' 7 pour nombre de jours
If Debug=True Then _
MsgBox "Le fichier " &vbLf& objFile.Drive &vbLf& _
objFile.Path & objFile.FileName & _
"." & objfile.Extension &vbLf& " sera supprimé car modifié le " & _
fnConversionDate(objFile.LastModified) &vbLf& _
Now & " - " & fnConversionDate(objFile.LastModified) & " = " & _
dtDiffFile,vbCritical,"Verif DELETE=OUI"
If Debug=False Then objFile.Delete(objFile.Path & objFile.FileName)
Else
If Debug=True Then _
MsgBox "Le fichier " &vbLf& objFile.Drive & _
objFile.Path & objFile.FileName & _
"." & objfile.Extension &vbLf& " ne sera pas supprimé car modifié le " & _
fnConversionDate(objFile.LastModified) &vbLf& _
Now & " - " & fnConversionDate(objFile.LastModified) & " = " & _
dtDiffFile,vbInformation,"Verif DELETE=NON"
End If
Next
Else
If Debug=True Then MsgBox "le répertoire " & strPath & " n'existe pas"
End If
Set objWMIService = Nothing
Set colFiles = Nothing
Function fnConversionDate(strDateUTC)
fnConversionDate = Mid(strDateUTC, 7, 2) & "/" & Mid(strDateUTC, 5, 2) & "/" & _
Left(strDateUTC, 4) & " " & Mid(strDateUTC, 9, 2) & ":" & _
Mid(strDateUTC, 11, 2) & ":" & Mid(strDateUTC, 13, 2)
End Function