关于递归移动文件的问题

Question

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

这是一个关于在各个子文件夹移动文件到另一个文件夹中的脚本只有当该文件是新

例如

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

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

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

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

预先感谢您。

编辑

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。此外，因为我只能用NotePad写vbs，所以我想不出有没有检查现有文件的错误。这是对的吗？

请给我伸出援助之手。我会非常感谢你的好意。

Answer 1

我测试了一下，这几乎没有窍门。你显然想要添加错误陷阱，而不是，但它确实是你以后的样子。我为文件类型使用了一个数组，因此您可以轻松地添加或删除它，并为驱动器号设置常量。

当然，你可以使它更像日期/时间比较而不仅仅是存在，但这是足够好的基础。

' 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