VBS script to copy files and folders across network

Question

I needed to copy all of my photos from my old laptop to my new laptop. This is a quick and dirty script that I put together (based on other scripts on this site) to copy files from one network location to another. I wanted the process to be able to recover in case of a network copy error because the total time to copy all of my photos was 40 hours.

lastFileLog is a file used to keep track of the last file that was copied. This is needed to recover from a partial copy. Windows seems to allocate the full file size even when the file fails to copy. So I just keep track of the last file to copy it again on failure. objStartFolder is the starting path on the source network location.

'initialize paths
objStartFolder = "\\owner-pc\d\pics"
lastFileLog = "c:\Files\misc\archive.log"
sourceRoot = "\\owner-pc\d"
targetRoot = "c:\Files"


Set objFSO = CreateObject("Scripting.FileSystemObject")

'read log
Set objFile = objFSO.OpenTextFile(lastFileLog)
Do Until objFile.AtEndOfStream
    replacefile= objFile.ReadLine
    Wscript.Echo "This file will be replaced: " & replacefile
Loop
objFile.Close

'copy files
Set objFolder = objFSO.GetFolder(objStartFolder)
ShowSubfolders objFSO.GetFolder(objStartFolder)

'clear log
Set objFileLog = objFSO.CreateTextFile(lastFileLog,True)
objFileLog.Write ""
objFileLog.Close

Sub ShowSubFolders(Folder)
    For Each Subfolder in Folder.SubFolders

        Wscript.Echo Subfolder.Path

        if not(objFSO.FolderExists(replace(Subfolder.Path,sourceRoot,targetRoot))) then
          objFSO.CreateFolder(replace(Subfolder.Path,sourceRoot,targetRoot))
        end if

        Set objFolder = objFSO.GetFolder(Subfolder.Path)
        Set colFiles = objFolder.Files
        For Each objFile in colFiles

            if not(objFSO.FileExists(replace(Subfolder.Path & "\" & objFile.Name,sourceRoot,targetRoot))) then 
              Wscript.Echo Subfolder.Path & "\" & objFile.Name

              Set objFileLog = objFSO.CreateTextFile(lastFileLog,True)
              objFileLog.Write Subfolder.Path & "\" & objFile.Name
              objFileLog.Close

              objFSO.CopyFile Subfolder.Path & "\" & objFile.Name, replace(Subfolder.Path & "\" & objFile.Name,sourceRoot,targetRoot)

            elseif replacefile = Subfolder.Path & "\" & objFile.Name then
              Wscript.Echo "Replacing ... " & Subfolder.Path & "\" & objFile.Name  
              objFSO.CopyFile Subfolder.Path & "\" & objFile.Name, replace(Subfolder.Path & "\" & objFile.Name,sourceRoot,targetRoot),true            
            else
              Wscript.Echo "Skip ... " & Subfolder.Path & "\" & objFile.Name
            end if
        Next
        ShowSubFolders Subfolder
    Next
end sub

Answer 1

For Folder: Try This.

Option Explicit
Dim obj,Itemcoll1,a,b
Set obj=CreateObject("Shell.Application")
Function SelectFold1(Desc)
Set SelectFold1=obj.BrowseForFolder(0,Desc,0,"C:\Users\Mohammed Sajjad\Desktop\")
End Function

Set Itemcoll1=SelectFold1("Copy: ").Items
SelectFold1("Paste: ").CopyHere Itemcoll1 'Use MoveHere if you want to move
MsgBox "Completed"

For File:

Option Explicit
Dim objApp : Set objApp = CreateObject("Shell.Application")
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objSHL : Set objSHL = CreateObject("WScript.Shell")

'Browse for Folder
'----------------------------------------------------------
Function SelectFold()
     Dim objFolder
     Set objFolder = objApp.BrowseForFolder(0,"Select a Folder",0,0)
     If objFolder Is Nothing Then
     MsgBox "Canceled"
     WScript.Quit
     Else
     SelectFold = objFolder.Self.Path & "\"
     End If
End Function
'----------------------------------------------------------
'Browse for file
'----------------------------------------------------------
Function SelectFile()
Dim tempFolder : Set tempFolder = objFSO.GetSpecialFolder(2)
Dim tempFile : tempFile = objFSO.GetTempName() & ".hta"
Dim path : path = "HKCU\Volatile Environment\MsgResp"
 With tempFolder.CreateTextFile(tempFile)
    .Write "<input type=file name=f>" & _
     "<script>f.click();(new ActiveXObject('WScript.Shell'))" & _
     ".RegWrite('HKCU\\Volatile Environment\\MsgResp', f.value);" & _
     "close();</script>"
    .Close
 End With
 objSHL.Run tempFolder & "\" & tempFile, 0, True
 If objSHL.RegRead(path) = "" Then
  objSHL.RegDelete path
  objFSO.DeleteFile tempFolder & "\" & tempFile
  WScript.Quit
 End If
 SelectFile = objSHL.RegRead(path)
 objSHL.RegDelete path
 objFSO.DeleteFile tempFolder & "\" & tempFile
End Function
'----------------------------------------------------------
objFSO.CopyFile SelectFile, SelectFold