VBS Script to move files older than X days

Arceon

Weaksauce
Joined
Sep 25, 2006
Messages
85
I've been looking for a script to move files from a folder (and all subdirectories) that are over 31 days old for archiving purposes. So far Googles come up with:

Code:
    Option Explicit
'****
'*  This VBScript moves all files created more than "cDAZ" days
'*  from folder "cFOL" to folder "cMOV" and logs each to "cLOG".
'*  (Note: the values of "cFOL" and "cMOV" should end with "\".)
'****
   '*
   '*  Declare Constants
   '*
    Const cVBS = "Move.vbs"        '= script name
    Const cLOG = "Move.log"        '= log filename
    Const cFOL = "C:\Test\"        '= source folder
    Const cMOV = "C:\Test2\"       '= dest. folder
    Const cDAZ = 31                '= # days
   '*
   '*  Move_Files()
   '*
    Dim strMSG
        strMSG = " files moved from " & cFOL & " to " & cMOV
    MsgBox Move_Files(cFOL) & strMSG,vbInformation,cVBS

Function Move_Files(folder)
    Move_Files = 0
   '*
   '*  Declare Variables
   '*
    Dim strDAT
    Dim intDAZ
    Dim arrFIL()
  ReDim arrFIL(0)
    Dim intFIL
        intFIL = 0
    Dim strFIL
    Dim intLEN
        intLEN = 0
    Dim strLOG
        strLOG = "echo " & cVBS & " -- " & Now & vbCrLf
    Dim dtmNOW
        dtmNOW = Now
   '*
   '*  Declare Objects
   '*
    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objGFO
    Dim objGFI
   '*
   '*  Validate folders
   '*
    If Not objFSO.FolderExists(cFOL) _
    Or Not objFSO.FolderExists(cMOV) Then
        MsgBox "A folder does not exist!",vbExclamation,cVBS
        Exit Function
    End If
   '*
   '*  Process folder
   '*
    Set objGFO = objFSO.GetFolder(folder)
    Set objGFI = objGFO.Files
   '*
   '*  Select Files
   '*
    For Each strFIL In objGFI
        strDAT = strFIL.DateCreated
        intDAZ = DateDiff("d",strDAT,dtmNOW)
        If intDAZ > cDAZ Then
            intFIL = intFIL + 1
            ReDim Preserve arrFIL(intFIL)
            arrFIL(intFIL) = strFIL.Name
            If intLEN < Len(strFIL.Name) Then
                intLEN = Len(strFIL.Name)
            End If
        End If
    Next
   '*
   '*  Move Files
   '*
    For intFIL = 1 To UBound(arrFIL)
        strFIL = arrFIL(intFIL)
        objFSO.MoveFile folder & strFIL, cMOV & strFIL
        strLOG = strLOG & "move " & folder & strFIL _
               & Space(intLEN-Len(strFIL)+1) _
               & cMOV & strFIL & vbCrLf
    Next
   '*
   '*  Destroy Objects
   '*
    Set objGFI = Nothing
    Set objGFO = Nothing
        strLOG = strLOG & "echo " & UBound(arrFIL) & " files moved"
        objFSO.CreateTextFile(cLOG,True).Write(strLOG)
    Set objFSO = Nothing
   '*
   '*  Return Results
   '*
    Move_Files = UBound(arrFIL)
End Function
However this doesn't move files from subdirectories, or allow me to specify a file extension. Anyone out there know how to add these two features in? Any help is greatly appreciated :)
 
*Slaps head*

Someone mentioned robocopy a while back but i presumed it was a pay-for application :rolleyes:

Thanks a lot :)
 
Back
Top