0
votes

This is my first question and hope you can help.

It's a script about moving file in every sub folders into another folder only if the file is new

For example

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

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

What i want to do right now is that when it finds there's a new file with extension Pdf,zip,xls in C:\Test\Sub2\Sub, it will move to D:\Test\Sub2\Sub directly.

Then it will loop the whole folder of test and move the file according the above rule. I have been searching for some example but those don't fit.

Thank you in advance.

Edit

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 

I can loop through the sub folders but can't move to the folder according the source folder. For example, FileA come from D:\Temp\A. It'd be moved to B:\Temp\A. But now it moved to B:\Temp only. Furthermore, since I can only use NotePad to write vbs, i can't figure out is there any bug for checking existing file. Is it correct?

Please lend me a helping hand. I will be very grateful for your kindness.

1
Please show us what you've tried yourself.Jean-François Corbett
I've showed it. Please have a lookblami

1 Answers

0
votes

I tested it out and this pretty much does the trick. You obviously want to add error trapping and what not, but it does what you were after. I'm using an array for the file types so you can add or remove to it with ease, and constants for the drive letters.

You can of course make it more robust like do a date/time compare instead of just an if exist, but this is good enough foundation.

' 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