Вопрос о рекурсивно перемещающемся файле - PullRequest
0 голосов
/ 27 июня 2011

Это мой первый вопрос и надеюсь, вы можете помочь.

Это скрипт о перемещении файла из каждой подпапки в другую папку, только если файл новый

Например

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, он сразу перейдет к 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. Кроме того, поскольку я могу использовать только блокнот для записи VBS, я не могу понять, есть ли какая-либо ошибка для проверки существующего файла. Это правильно?

Пожалуйста, протяните мне руку помощи. Буду очень признателен за вашу доброту.

1 Ответ

0 голосов
/ 29 июня 2011

Я проверил это, и это в значительной степени помогает. Вы, очевидно, хотите добавить перехват ошибок, а что нет, но он делает то, что вы после. Я использую массив для типов файлов, чтобы вы могли легко добавлять или удалять его, а также константы для букв дисков.

Вы, конечно, можете сделать его более надежным, например, сравнить дату / время, а не просто если существует, но это достаточно хорошая основа.

' 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...