VBScript to Move Files

You can use schedule this script to move files on a server daily from on location to another.

Simple copy the script to a text file using notepad.exe and save as .vbs or download here.

' Use at your own risk
' Customize as you wish

Const cFROM = "E:\Source"
Const cDEST_ROOT = "E:\Destination"
Const cDAYS_OLD = 5
Const cFROM_EMAIL = "[email protected]"
Const cTO_EMAIL = "[email protected]"
Const cCC_EMAIL = "[email protected]"

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

' Check directory existence
If Not objFSO.FolderExists(cFROM) Then
strMessage = "Either soure or destination folder does not exists." & vbCrLf & _
"Source Folder:" & vbTab & cFROM & vbCrLf & _
"Please make sure that source path is correct and exists before running the " & _
"script again." & vbCrLf & vbCrLf & _
"Thanks."
Call SendEmail("Error:Move Script", strMessage)
Call Destroy()
WScript.Quit
End If

strDest = cDEST_ROOT & Month(Now) & "-" & Year(Now) & "\"

' Create destination directory if doesn not exists
If Not objFSO.FolderExists(strDest) Then
objFSO.CreateFolder(strDest)
End If

Dim objGFO
Set objGFO = objFSO.GetFolder(cFROM)

Dim objGFI
Set objGFI = objGFO.Files

strMessage = "This summary report contains the total number of files that were moved to " & _
strDest & " from " & cFROM & vbCrLf & vbCrLf
intGFI = 0
Dim strGFI
For Each strGFI in objGFI
If DateDiff("d", strGFI.DateLastModified, Date) >= cDAYS_OLD Then
strFileName = strGFI.Name

If objFSO.FileExists(strDest & strFileName) Then
objFSO.DeleteFile strDest & strFileName, True
End If

objFSO.MoveFile cFROM & strFileName, strDest
intGFI = intGFI + 1
'strMessage = strMessage & intGFI & ". " & cFROM & strFileName & " was moved successfully." & vbCrLf
'Exit For
End If
Next

strMessage = strMessage & vbCrLf & "Successfully archived " & intGFI & " file(s) to " & strDest & vbCrLf

Call SendEmail("Move Script Daily Summary Report", strMessage)
Call Destroy()

Sub SendEmail(strSubject, strMessage)

Dim strEmailBody

Dim objEmail
Set objEmail = CreateObject("CDO.Message")

'Email fields
objEmail.From = cFROM_EMAIL
objEmail.To = cTO_EMAIL
objEmail.Cc = cCC_EMAIL
objEmail.Subject = strSubject & vbTab & "***Timestamp*** " & Now()
objEmail.Textbody = strMessage

'Smtp configurations
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
"smtp.usadata.com"
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

objEmail.Configuration.Fields.Update
objEmail.Send

End Sub


Sub Destroy()

Set objGFI = Nothing
Set objGFO = Nothing
Set objFSO = Nothing

End Sub