在子文件夹中搜索文件,然后复制

时间:2018-08-19 20:39:14

标签: function vbscript scripting subdirectory

我正在尝试在目录的子文件夹中搜索特定的文件名,然后将该文件复制到目标文件夹。请忽略所有WScript.Echo语句。该脚本通过FileExists if语句传递,但继续使复制过程失败。我认为这是错误的循环。

Option Explicit

' 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:\Users\206565068\Desktop\hardDriveScript\filelist.txt"

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

' The source path for the copy operation.
Const strRootFolder = "C:\Users\206565068\Desktop\sourceTest"

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

Dim objFolder, objFolderItem, objSubFolders, subfolder
Dim strFullPathToSearch
strFullPathToSearch = ""

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

Dim strSourceFilePath
strSourceFilePath = ""

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

Public Function FindAndCopy()
    ' 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

    FindAndCopy = ""
    WScript.Echo "Step one"
    WScript.Echo strRootFolder

    On Error Resume Next
    Do Until objFileList.AtEndOfStream
        ' Read next line from file list and build filepaths
        strFileToCopy = objFileList.Readline
        WScript.Echo strFileToCopy
        WScript.Echo "Step Two"
        Set objSubFolders = FSO.GetFolder(strRootFolder).SubFolders
        For Each subfolder In objSubFolders
            WScript.Echo "Searching subs"
            WScript.Echo subfolder.Path
            strFullPathToSearch = strRootFolder & "\" & subfolder.Name & "\" & strFileToCopy
            strSourceFilePath = objFSO.BuildPath(strFullPathToSearch, strFileToCopy)
            strTargetFilePath = objFSO.BuildPath(strTargetFolder, strFileToCopy)
            If FSO.FileExists(strFullPathToSearch) Then
                ' Copy file to specified target folder.
                WScript.Echo "File Exists"
                Err.Clear
                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
                Else
                    ' Error copying file
                    iFailure = iFailure + 1
                    WScript.Echo "File failed"
                    TextOut "Error " & Err.Number & " (" & Err.Description & ") trying to copy " & strFileToCopy
                End If
            End If
        Next
    Loop

    strResults = strResults & vbCrLf
    strResults = strResults & iSuccess & " files copied successfully." & vbCrLf
    strResults = strResults & iFailure & " files generated errors" & vbCrLf
    WScript.Echo strResults
End Function

0 个答案:

没有答案