Auto Move Files by Age
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