关于递归移动文件的问题

Question

这是我的第一个问题，希望您能提供帮助。

这是一个脚本，仅当文件是新文件时，才将每个子文件夹中的文件移动到另一个文件夹中

例如

C:\Test\Sub1 
C:\Test\Sub1\Sub 
C:\Test\Sub2\Sub 

D:\Test\Sub1 
D:\Test\Sub1\Sub 
D:\Test\Sub2\Sub 

我现在要做的是，当它发现C:\Test\Sub2\Sub中有一个扩展名为Pdf,zip,xls的新文件时，它将直接移动到D:\Test\Sub2\Sub。

然后它将循环整个test文件夹并按照上述规则移动文件。 我一直在寻找一些例子，但那些不适合。

提前谢谢你。

编辑

Option Explicit

const DestFolder = "B:\Testing\"

MoveFiles

Sub MoveFiles
    ' folder to look in
    Dim strFolderPath : strFolderPath = "D:\Temp\Testing\"

    Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim RegEx : Set RegEx = New RegExp

    ' specify the extension you want to search for; seperate with a |
    ' currently searching for .txt and .mdb files
    RegEx.Pattern = "\.(pdf|zip|xls|txt)$"
    RegEx.IgnoreCase = True

    RecurseFolder objFSO, strFolderPath, RegEx
End Sub

Sub RecurseFolder(objFSO, strFolderPath, RegEx)
    Dim objFolder : Set objFolder = objFSO.GetFolder(strFolderPath)

    Dim objFile, strFileName,dest
    For Each objFile In objFolder.Files
        strFileName = objFile.Path

    If RegEx.Test(strFileName) Then 

                  'Checking whether file exist in destination
        if not objFSO.FileExists(destfolder.strFileName) then 
            objFile.Move destfolder
        else
            msgbox "File is already existed"
      End If
    End If
    Next

    Dim objSubFolder 
    For Each objSubFolder In objFolder.SubFolders
        RecurseFolder objFSO, objSubFolder.Path, RegEx
    Next
End Sub 

我可以循环浏览子文件夹，但不能根据源文件夹移动到文件夹。例如， FileA 来自D:\Temp\A。它将被移至B:\Temp\A。但现在它只移到了B:\Temp。此外，由于我只能使用记事本编写 vbs，我无法弄清楚检查现有文件是否有任何错误。对吗？

请帮帮我。我会非常感谢你的好意。

Answer 1

我对其进行了测试，这几乎可以解决问题。您显然想要添加错误捕获和什么，但它会满足您的需求。我为文件类型使用了一个数组，因此您可以轻松地添加或删除它，并为驱动器号使用常量。

你当然可以让它更健壮，比如做一个日期/时间比较而不是仅仅一个 if 存在，但这是足够好的基础。

' Build array of file types
arrFileTypes = Split("PDF,XLS,ZIP,vbs,jpg", ",")

Const sourceDrive = "C:"
Const targetDrive = "P:"


' Make initial call to get subfolders
Set objFSO = CreateObject("Scripting.FileSystemObject")
ShowSubFolders objFSO.GetFolder("C:\test")

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
' Subroutine to enumerate folder, called recursively
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
Sub ShowSubFolders(Folder)

    For Each Subfolder in Folder.SubFolders

        ' Get a list of the files in the folder     
        Set objFolder = objFSO.GetFolder(Subfolder.Path)
        Set filesList = objFolder.Files

        ' Loop each file and see if it is on the D:
        For Each file In filesList

            sourceFile = objFolder.Path & "\" & file.Name
            targetFile = Replace(sourceFile, sourceDrive, targetDrive)

            ' Loop allowed extension types
            For Each extType In arrFileTypes

                ' Extension match AND it is already there
                If (UCase(Right(sourceFile, 3)) = UCase(extType)) And objFSO.FileExists(targetFile) Then
                    WScript.Echo "The file already exists on the target " & sourceFile
                ' Extension match and it is NOT already there
                ElseIf (UCase(Right(sourceFile, 3)) = UCase(extType)) And objFSO.FolderExists(replace(objFolder.Path, sourceDrive, targetDrive)) Then
                    WScript.Echo "I would move the file, it isn't on target " & sourceFile
                    objFSO.MoveFile sourceFile, targetFile
                End If
            Next  

        Next

        ShowSubFolders Subfolder

    Next

End Sub