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，C:\Test\Sub2\Sub的新文件时，它将移至{直接{1}}

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

提前谢谢你。

修改

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。此外，由于我只能使用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

关于递归移动文件的问题

1 个答案: