Option Explicit Const cstPath = "C:\Users\cs_JMO\Documents\SCRIPTS\" Const cstExtension = "log" Dim objFso, colFile Set objFso = CreateObject("Scripting.FileSystemObject") For Each colFile in objFso.GetFolder(cstPath).Files If LCase(objFso.GetExtensionName(colFile)) = cstExtension Then Dim strSplitDate strSplitDate = Right(Split(colFile,".")(UBound(Split(colFile,"."))-1),6) If IsNumeric(strSplitDate) Then CheckFile colFile, strSplitDate End if Next Sub CheckFile(colFile, strSplitDate) Dim dtDeb, dtFin, dtDiff dtDeb = Right(Date,4) & "/" & Mid(Date,4,2) & "/" & Left(Date,2) dtFin = Left(Year(Date),2) & Left(strSplitDate, 2) & "/" & Mid(strSplitDate,3,2) & "/" & Right(strSplitDate,2) dtDiff = DateDiff("m" , dtFin , dtDeb) Select Case dtDiff Case 0,1,2,3,4,5 MsgBox colFile & vbCrLf & colFile.Name & vbCrLf & strSplitDate & vbCrLf & vbCrLf & _ "< 6 mois -> A conserver" & vbCrLf & dtDiff & " mois",,"Case 0,1,2,3,4,5" Case 6 If Right(dtDeb, 2) >= Right(dtFin, 2) Then MsgBox colFile & vbCrLf & colFile.Name & vbCrLf & strSplitDate & vbCrLf & vbCrLf & _ "6 mois -> A supprimer",,"Case 6" Else MsgBox colFile & vbCrLf & colFile.Name & vbCrLf & strSplitDate & vbCrLf & vbCrLf & _ "6 mois -> A conserver",,"Case 6" End If Case Else MsgBox colFile & vbCrLf & colFile.Name & vbCrLf & strSplitDate & vbCrLf & vbCrLf & _ "> 6 mois -> A supprimer" & vbCrLf & dtDiff & " mois",,"Case Else" End Select End Sub
Option Explicit
Const cstPath = "C:\Users\603161764\Documents\SCRIPTS\"
Const cstPathArchiv = "Archiv\"
Const cstExtension = "log"
Dim objFso, colFile, f
Set objFso = CreateObject("Scripting.FileSystemObject")
If Not objFso.FolderExists(cstPath & cstPathArchiv) Then
objFso.CreateFolder(cstPath & cstPathArchiv)
End If
For Each colFile in objFso.GetFolder(cstPath).Files
If LCase(objFso.GetExtensionName(colFile)) = cstExtension Then
Dim strSplitDate
strSplitDate = Right(Split(colFile,".")(UBound(Split(colFile,"."))-1),6)
If IsNumeric(strSplitDate) Then CheckFile colFile, strSplitDate
End if
Next
Sub CheckFile(colFile, strSplitDate)
Dim dtDeb, dtFin, dtDiff
dtDeb = Right(Date,4) & "/" & Mid(Date,4,2) & "/" & Left(Date,2)
dtFin = Left(Year(Date),2) & Left(strSplitDate, 2) & "/" & Mid(strSplitDate,3,2) & "/" & Right(strSplitDate,2)
dtDiff = DateDiff("m" , dtFin , dtDeb)
Select Case dtDiff
Case 0,1,2,3,4,5
MsgBox colFile & vbCrLf & colFile.Name & vbCrLf & strSplitDate & vbCrLf & vbCrLf & _
"< 6 mois -> A conserver" & vbCrLf & dtDiff & " mois",,"Case 0,1,2,3,4,5"
objFso.MoveFile colFile, cstPath & cstPathArchiv
Case 6
If Right(dtDeb, 2) >= Right(dtFin, 2) Then
MsgBox colFile & vbCrLf & colFile.Name & vbCrLf & strSplitDate & vbCrLf & vbCrLf & _
"6 mois -> A supprimer",,"Case 6"
objFso.DeleteFile colFile
Else
MsgBox colFile & vbCrLf & colFile.Name & vbCrLf & strSplitDate & vbCrLf & vbCrLf & _
"6 mois -> A conserver",,"Case 6"
objFso.MoveFile colFile, cstPath & cstPathArchiv
End If
Case Else
MsgBox colFile & vbCrLf & colFile.Name & vbCrLf & strSplitDate & vbCrLf & vbCrLf & _
"> 6 mois -> A supprimer" & vbCrLf & dtDiff & " mois",,"Case Else"
objFso.DeleteFile colFile
End Select
End Sub