Script for file copying from a list RRS feed

  • Question

  • Hi there,

    I came across the script below in an old post and it was incredibly useful for copying files from one location to another based on a text list.  What I'm trying to do is include subfolders. 

    I'm a total newb, so if you're keen to add in the code that would execute this it would be very much appreciated.

    Primarily I need it to:

    - look at a folder that may or may not contain many subfolders and copy the files referenced in the list to the new location

    Then, do one of two things:

    1. the subfolder structure of the source is replicated at the destination, or

    2 . all files plonked into the one folder

    Presumably this will be two different scripts, I just run the required one?

    Many thanks!

    ' The list of files to copy. Should be a text file with one file on each row. No paths - just file name.
    Const strFileList = "C:\Desktop\list.txt"

    ' Should files be overwriten if they already exist? TRUE or FALSE.
    Const blnOverwrite = FALSE

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

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

    Dim objFolder, objFolderItem

    ' Get the source path for the copy operation.
    Dim strSourceFolder
    Set objFolder = objShell.BrowseForFolder(0, "Select source folder", 0 )
    If objFolder Is Nothing Then Wscript.Quit
    Set objFolderItem = objFolder.Self
    strSourceFolder = objFolderItem.Path

    ' Get the target path for the copy operation.
    Dim strTargetFolder
    Set objFolder = objShell.BrowseForFolder(0, "Select target folder", 0)
    If objFolder Is Nothing Then Wscript.Quit
    Set objFolderItem = objFolder.Self
    strTargetFolder = objFolderItem.Path

    Const ForReading = 1
    Dim objFileList
    Set objFileList = objFSO.OpenTextFile(strFileList, ForReading, False)

    Dim strFileToCopy, strSourceFilePath, strTargetFilePath
    Dim strResults, iSuccess, iFailure
    iSuccess = 0
    iFailure = 0

    On Error Resume Next
    Do Until objFileList.AtEndOfStream
        ' Read next line from file list and build filepaths
        strFileToCopy = objFileList.Readline
        strSourceFilePath = objFSO.BuildPath(strSourceFolder, strFileToCopy)
        strTargetFilePath = objFSO.BuildPath(strTargetFolder, strFileToCopy)
        ' Copy file to specified target folder.
        objFSO.CopyFile strSourceFilePath, strTargetFilePath, blnOverwrite
        If Err.Number = 0 Then
            ' File copied successfully
            iSuccess = iSuccess + 1
            If Instr(1, Wscript.Fullname, "cscript.exe", 1) > 0 Then
                ' Running cscript, output text to screen
                Wscript.Echo strFileToCopy & " copied successfully"
            End If
            ' Error copying file
            iFailure = iFailure + 1
            TextOut "Error " & Err.Number & " (" & Err.Description & ") trying to copy " & strFileToCopy
        End If

    strResults = strResults & vbCrLf
    strResults = strResults & iSuccess & " files copied successfully." & vbCrLf
    strResults = strResults & iFailure & " files generated errors" & vbCrLf
    Wscript.Echo strResults

    Sub TextOut(strText)
        If Instr(1, Wscript.Fullname, "cscript.exe", 1) > 0 Then
            ' Running cscript, use direct output
            Wscript.Echo strText
            strResults = strResults & strText & vbCrLf
        End If
    End Sub

    • Moved by Bill_Stewart Monday, March 12, 2018 9:05 PM This is not "scripts on demand"
    Tuesday, January 30, 2018 1:10 AM

All replies