BackBurner.vbs

A SendTo script by Richard A. DeVeneziaSend Feedback
Place the script in your SendTo folder. Right click on a file or folder to copy from source to destination, replicating the path to the source in the destination. All necessary paths are automatically created.
The deeply nested file will be copied to the destination with the same nesting.
When destination = "E:\"
D:\Projects\SAS\Hash\AA\readme.txt will be copied to
E:\Projects\SAS\Hash\AA\readme.txt
Download the script or copy it from below.
'--------------------------------------------------------------------
' Various initialisations. These are the only things that you need
' to look at and possibly change.
'--------------------------------------------------------------------

unpromptedDestination = "E:\"

promptForFolder = false ' true -> BrowseForFolder dialog will open
replicatePath   = true  ' true -> the full source path is replicated
noConfirmation  = true  ' true -> prevent questions during file copying
newName         = true  ' true -> prevent copying over existing files

'--------------------------------------------------------------------
' BackBurner.vbs
' Richard A. DeVenezia, 06/10/2003
' http://www.devenezia.com
'
' Send me some mail if you find this useful.
'
' Purpose: Copy from source to destination,
' replicating the path to the source in the destination
'
' Anticipated use:
' 1. Place this script in your Send To folder
' 2. In Explorer highlight one or more files and folders,
'    right click over selection and choose SendTo -> BackBurner.vbs
'
' Updated
' 10mar05 - Use CopyHere so animated progress will be shown
'           when large amounts of copying are occurring.
'
' 07jul05 - By Nick Carter (NickCarter[dot]RMC[at]gmail[dot]com).
'           Use variable replicatePath to control whether full source path
'           is replicated or not.
'           Use variable copyFlags to hold CopyHere flags:
'           noConfirmation and newName.

BIF_RETURNONLYFSDIRS = &H0001
BIF_EDITBOX = &H0010
BIF_VALIDATE = &H0020
BIF_NEWDIALOGSTYLE = &H0040

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

Dim ws
Set ws = CreateObject("WScript.Shell")

Dim oShell
Set oShell = CreateObject("Shell.Application")

if promptForFolder then

  '--------------------------------------------------------------------
  ' Obtain destination root from user
  '--------------------------------------------------------------------

  Dim oFolder
  Set oFolder = oShell.BrowseForFolder _
    ( _
      &H0, _
      "Select the folder where the backup should go." & vbCrLf & _
      "Note: Clicking OK after typing in a new folder path will create the folder.", _
      BIF_NEWDIALOGSTYLE + BIF_validate + BIF_Editbox + BIF_RETURNONLYFSDIRS _
    )

  if oFolder is Nothing then wscript.Quit(0)

  ' Get absolute path of folder,
  ' technique is from atx post to microsoft.public.scripting.vbscript on 19Jan05

  Set oFolderItem = oFolder.Items.Item

  if oFolderItem is Nothing then
     Set oFolderItem = fso.GetFolder (ws.SpecialFolders (oFolder&""))
  end if

  destinationRoot = oFolderItem.path

  if not fso.FolderExists (destinationRoot) then
    msgbox oFolder & " is not a place for backups"
    wscript.Quit(0)
  end if

else

  destinationRoot = unpromptedDestination

end if

'--------------------------------------------------------------------
' Create the destination root if necessary
' Should never be necessary if BrowseForFolder used to obtain path.
'--------------------------------------------------------------------

Dim parts
Dim destinationRootPath

parts = Split (destinationRoot, "\", -1, 1)

for i = lbound(parts) to ubound(parts)
  if parts(i) <> "" then
    destinationRootPath = destinationRootPath & parts(i) & "\"

    if (not fso.FolderExists (destinationRootPath)) then
      fso.CreateFolder (destinationRootPath)
    end if
  end if
next

'--------------------------------------------------------------------
' Each argument is a file or folder selected for Send To processing.
'--------------------------------------------------------------------

Dim count
Dim msg

count = 0
msg = ""

for each arg in wscript.arguments

  destinationPath = destinationRootPath

  if replicatePath then
    '------------------------------------------------------------------
    ' Create a replicate path to arg in the destination root
    '------------------------------------------------------------------
    parts = Split (arg, "\", -1, 1)
    for i = lbound(parts) to ubound(parts)-1
      if parts(i) <> "" and not (InStr (parts(i), ":" ) > 0) then
         destinationPath = destinationPath  & parts(i) & "\"
         if (not fso.FolderExists (destinationPath)) then
           fso.CreateFolder (destinationPath)
         end if
      end if
    next
  end if

  Dim oDestination
  Set oDestination = oShell.NameSpace ( destinationPath )

  '--------------------------------------------------------------------
  ' Set the flags for the CopyHere function
  ' 16: with no confirmation
  '  8: give a new name if file already exists
  '--------------------------------------------------------------------

  copyFlags=0

  if noConfirmation then
      copyFlags = copyFlags + 16
  end if
  if newName then
      copyFlags = copyFlags + 8
  end if

  '------------------------------------------------------------------
  ' Copy the arg to destination
  '------------------------------------------------------------------

  oDestination.CopyHere arg, copyFlags

  '------------------------------------------------------------------
  ' Track what has been copied
  '------------------------------------------------------------------

  count = count + 1

  if count > 1 then msg = msg & vbCrLf & "-----" & vbCrLf

  msg = msg & arg & " copied to" & vbCrLf & oDestination.Items.Item.Path

next

'------------------------------------------------------------------
' Indicate what was copied
'------------------------------------------------------------------

choice = ws.Popup (msg, 15, "Auto OK in 15 seconds", 64)

wscript.Quit(0)
This page was last updated 17 August 2003.