Auto Move Files by Age

August 24th, 2009

Since I use bittorrent to download my TV shows I have run into the problem of having tons of old shows in my downloads folder. I was using Belvedere from lifehacker.com on my old system but since I reformatted and reinstalled it I have had nothing but problems.

For some reason Belvedere would move my files, but the file would end up beng 0kb or 4kb (randomly between the two). I started looking into other options but didn’t find any programs that would move a file based on it’s creation date. After trying 4 or 5 different programs I decided that maybe a batch file would take care of my problems.

While reading up on batch files I found that a better solution would be a VBScript. VBScripts are easily run by windows, have many of the functions you might find in Visual Basic, and doesn’t require a compiler (simply rename a .txt file to .vbs).

The result is what you see below. I’m sure there are many things that can be changed or improved (please let me know in the comments) but it does the job. Just change the variables in the first few lines to fit your needs.

    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 = "Move7Days.vbs"        '= script name
    Const cLOG = "Move7Days.log"        '= log filename
    Const cFOL = "C:\Recordings\"			'= source folder
    Const cMOV = "C:\Recordings\Last Week\"             '= dest. folder
    Const cDAZ = 7                      '= # days
    Const cLOG = 1                     '= Create log?

   '*
   '*  Move_Files()
   '*
   '* Dim strMSG
   '*     strMSG = " files moved from " & cFOL & " to " & cMOV
   '* MsgBox Move_Files(cFOL) & strMSG,vbInformation,cVBS

   Move_Files(cFOL)

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 _
	And LCase(Right(strFIL.Name,4)) = ".mpg" 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"
        If cLOG = 1 Then
		objFSO.CreateTextFile(cLOG,True).Write(strLOG)
	End If
    Set objFSO = Nothing
   '*
   '*  Return Results
   '*
    Move_Files = UBound(arrFIL)
End Function
  1. No comments yet.
  1. No trackbacks yet.
You must be logged in to post a comment.