—————————————————————————————————————————————

Set FSo = CreateObject(“Scripting.FileSystemObject”)
Set folder = FSO.getFolder (“M:\millsys\millgest\magnet\comercial”)
for each file in folder.files
if (dateDiff(“d”, file.DateLastModified, now) >60) then
File.delete
end if
next

Dim SOURCE, TARGET
Dim fso, SourceObj

SOURCE = “M:\millsys\millgest\magnet\comercial”
TARGET = “D:\Publico\MagnetComercial”

Set fso = CreateObject(“Scripting.FileSystemObject”)
Set SourceObj = fso.GetFolder(SOURCE)

RecrusiveSearch SourceObj

Set SourceObj = Nothing
Set fso = Nothing

Private Sub RecrusiveSearch(sFolder)
Dim fld, fil
Dim strMonth, strDay, strYear, strDate

strMonth = “0” & Month(Date)
strMonth = Right(strMonth, 2)
strDay = “0” & Day(Date)
strDay = Right(strDay, 2)
strYear = Year(Date)

strDate = strYear & strMonth & strDay & “_”

If DateDiff(“d”, sFolder.DateLastModified, Now) > 10 Then
fso.CopyFolder sFolder.Path, Target & “\” & strDate & sFolder.Name
fso.DeleteFolder sFolder
Exit Sub
End If

For Each fld In sFolder.SubFolders
RecrusiveSearch fld
Next

For Each fil In sFolder.Files
If DateDiff(“d”, fil.DateLastModified, Now) > 10 Then
fso.CopyFile fil.Path, Target & “\” & strDate & fil.Name
fso.DeleteFile fil
End If
Next
End Sub

—————————————————————————————————————————————
Créditos : http://www.vbforums.com/showthread.php?578210-Recurse-through-sub-directories-Files-older-then-30-days

vbs–Apagando arquivos antigos