VB script to copy folders to a USB/Drive

Today I had to find a solution for a user to backup/copy his folders to a USB drive. Instead of using backup utilities, I wanted to try my luck in VB script. As usual Google'd and found hundreds of scripts. Took codes from several of them and compiled one which will copy folders from one drive to another with prompting the user that it is copying. The script creates an archive folder if it doesn't exist. Create a folder with the date and puts data inside that. So in case one of your backup is corrupted you will have date wise copies of your data.

The code is as below.

=================Code start=====================

Dim objFSO, objWshell, oIE, oIEDoc

set objWshell = Wscript.CreateObject("Wscript.Shell")
Set oIE = Wscript.CreateObject("InternetExplorer.Application")
oIE.Navigate "about:blank"
do while oIE.busy : wscript.sleep 10 : loop
Set oIEDoc = oIE.Document

oIE.AddressBar = False
oIE.StatusBar = False
oIE.ToolBar = False
oIE.Document.Body.Scroll = "no"
oIE.document.title = "... - Processing files"
oIE.height=100
oIE.width=200
oIE.Resizable = False
oIE.Visible = True

sMsg= "<center>Files are being copied.<br>Please wait...</center>"
oIEDoc.Body.Innerhtml= sMsg

sourceDir1 = "path\to\folder"
sourceDir2 = "path\to\folder"
sourceDir3 = "path\to\folder"
destinationDir = "USBDriveletter:\archive"

Set objFSO = CreateObject("Scripting.FileSystemObject")
IF objFSO.FolderExists(destinationDir) = FALSE THEN
objFSO.CreateFolder destinationDir
wscript.echo "Archive folder created"
ELSE
wscript.echo "Archive folder already exists"
END IF

const OverwriteExisting = True

strDirectory = destinationDir & "\" & replace(date,"/","_")
Set fso = CreateObject("Scripting.FileSystemObject")

if not fso.FolderExists(strDirectory) then
   Set objFolder = fso.CreateFolder(strDirectory)
end if
   fso.CopyFolder sourceDir1 , strDirectory & "\", OverwriteExisting
   fso.CopyFolder sourceDir2 , strDirectory & "\", OverwriteExisting
   fso.CopyFolder sourceDir3 , strDirectory & "\", OverwriteExisting

Set oIEDoc = Nothing
oIE.Quit
Set oIE = Nothing

Set objFSO = Nothing
Set objWshell = Nothing
Set WshShell = Nothing

MsgBox "Process completed successfully", 64 + 262144, "Process complete"
=================Code end=====================

Thanks to all who have published their code publicly. I am carrying it forward. Feel free to use and a comment if you feel it is good.

Anil

Phasellus facilisis convallis metus, ut imperdiet augue auctor nec. Duis at velit id augue lobortis porta. Sed varius, enim accumsan aliquam tincidunt, tortor urna vulputate quam, eget finibus urna est in augue.

No comments: