VBA to conditionally move files from one directory to another

[JohanGduToit]

Greetings Experts,

Files are FTP'd into a 'New' folder and then moved from the 'New' folder into another folder named 'Images'; BUT only move a file if it does NOT ALREADY exist in the 'Images' folder. If a file already exist in the 'Images' folder, then delete it from the 'New' folder and move on to the next file.

Here is what I have... the code works fine; but I get an error 'File already exist' when there's a duplicated filename. So I am trying to move all files in folder 'New' into folder "Images"; but only if the files do not already exist in the destination folder. Once the code has looped through the entire 'New' directory, any remaining files in the 'New' folder can then be deleted. (These remaining files will already exist in the 'Images' folder, so I don't need them).

Any help would be most welcomed!

Sub MoveFiles()

Dim NewFile As String

NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*")

    Do Until NewFile = ""
        Name "D:\ParGo\PODS\IMAGES\NEW\" & NewFile As "D:\ParGo\PODS\IMAGES\" & NewFile
        NewFile = Dir
    Loop

End Sub

 

[petertenthije]

This works for me.

Sub MoveFiles()

Dim NewFile As String

NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*")

    Do Until NewFile = ""
        If Dir("D:\ParGo\PODS\IMAGES\" & NewFile, vbDirectory) = "" Then
        
            Name "D:\ParGo\PODS\IMAGES\NEW\" & NewFile As "D:\ParGo\PODS\IMAGES\" & NewFile
            NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*")
        Else
            Kill "D:\ParGo\PODS\IMAGES\NEW\" & NewFile
            NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*")
        End If
    Loop

End Sub

 

[Micron]

You could modify the error handler to add handling other errors. I didn't anticipate file not found because I figured that can't happen when you're looping over files in a directory. If you get that, there must be something wrong with the way the code executes. Perhaps because you're trying to kill in 2 places, which isn't making sense to me. The idea was to do so only in the error handler. You could step through it (F8) and see what happens. Could also add other error numbers to the error handler. It was meant to be an example and not necessarily to be considered complete.

You could also see if other posted code works for you.
N.B. - please enclose code in code tags and maintain proper indentation. Use vba button on posting toolbar. Your code is too hard to read/follow. See how much easier post 11 is to read.

 

[JohanGduToit]

This works for me.

Sub MoveFiles()

Dim NewFile As String

NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*")

    Do Until NewFile = ""
        If Dir("D:\ParGo\PODS\IMAGES\" & NewFile, vbDirectory) = "" Then
       
            Name "D:\ParGo\PODS\IMAGES\NEW\" & NewFile As "D:\ParGo\PODS\IMAGES\" & NewFile
            NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*")
        Else
            Kill "D:\ParGo\PODS\IMAGES\NEW\" & NewFile
            NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*")
        End If
    Loop

End Sub

Hi Peter,

Thank you for your efforts... I have tried your code; but unfortunately it fails if there are more than one file in the source folder that already exist in the target folder. To test I manually copied 3x files from the target folder into the source folder and then ran the code. It successfully deletes (Kill) one of the 3 duplications in the source folder and the procedure completes without any errors; but two of the three files remain in the target folder.

 

[JohanGduToit]

Thank you to all respondents to my enquiry; much appreciated. Decided against spending additional time in attempting to resolve using 'moving' files and opt for making use of the fso method by rather copying files (if files do not already exist) and then deleting all files in the source folder afterwards. Here's the adapted code:

Sub CopyFilesNoOverwrite()

    Const srcFolderPath As String = "D:\ParGo\PODS\IMAGES\NEW"
    Const dstFolderPath As String = "D:\ParGo\PODS\IMAGES"
    
    With CreateObject("Scripting.FileSystemObject")
        If Not .FolderExists(srcFolderPath) Then
            MsgBox "THE SOURCE FOLDER DO NOT EXIST", vbCritical, "NO SOURCE"
            Exit Sub
        End If
        If .FolderExists(dstFolderPath) Then
            Dim fsoFile As Object
            Dim FilePath As String
            For Each fsoFile In .GetFolder(srcFolderPath).Files
                FilePath = dstFolderPath & "\" & fsoFile.Name
                If Not .FileExists(FilePath) Then                           'Only copy files that do not exist in target folder
                    .CopyFile Source:=fsoFile.Path, Destination:=FilePath
                End If
            Next fsoFile
            Kill srcFolderPath & "\*.*"
            Else
                .copyfolder Source:=srcFolderPath, Destination:=dstFolderPath
        End If
    End With

End Sub

 

[Micron]

IMO the Dir part should be like this (note not using vbDirectory attribute because that finds folder names too). As written it seems the lack of setting FileName inside the loop would be the issue.

Dim FileName As String
FileName = Dir("path here\")

Do While FileName <> ""
    Debug.Print FileName
    FileName = Dir()
Loop

EDIT - I see that you solved via another route.

 

[JohanGduToit]

IMO the Dir part should be like this (note not using vbDirectory attribute because that finds folder names too). As written it seems the lack of setting FileName inside the loop would be the issue.

Dim FileName As String
FileName = Dir("path here\")

Do While FileName <> ""
    Debug.Print FileName
    FileName = Dir()
Loop

EDIT - I see that you solved via another route.

Thank you Micron, I'm about to sign-off; but will definitely test this tomorrow and revert back.

 

[petertenthije]

Hi Peter,

Thank you for your efforts... I have tried your code; but unfortunately it fails if there are more than one file in the source folder that already exist in the target folder. To test I manually copied 3x files from the target folder into the source folder and then ran the code. It successfully deletes (Kill) one of the 3 duplications in the source folder and the procedure completes without any errors; but two of the three files remain in the target folder.

That's odd, I tried and it works here.
I even copied new photos and renamed them to the same name as the old photos, just to be sure that the old photo was not overwriting the new photos.

Did you get an error message?

 

[JohanGduToit]

IMO the Dir part should be like this (note not using vbDirectory attribute because that finds folder names too). As written it seems the lack of setting FileName inside the loop would be the issue.

Dim FileName As String
FileName = Dir("path here\")

Do While FileName <> ""
    Debug.Print FileName
    FileName = Dir()
Loop

EDIT - I see that you solved via another route.

Morning Micron,

Tried the "Do While"...and stepped into the code (F8); tested with 3x manually created 'duplicate' filenames in source directory. Code only deletes one of the duplications and then the sub completes without any error...it does not move onto the next file. When running a 2nd time, again, only one of the remaining duplications gets deleted and then sub completes.

NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*")
    
    Do While NewFile <> ""
        Debug.Print NewFile
        If Dir("D:\ParGo\PODS\IMAGES\" & NewFile) = "" Then
            Name "D:\ParGo\PODS\IMAGES\NEW\" & NewFile As "D:\ParGo\PODS\IMAGES\" & NewFile
            NewFile = Dir()
            Else
                Kill "D:\ParGo\PODS\IMAGES\NEW\" & NewFile
                NewFile = Dir()
        End If
    Loop

 

[JohanGduToit]

Working Code!!! Seems like the combination of using "Do While" (as oppose to "Do Until") and setting NewFile = Dir(<fullpath>) within the loop resolved whatever the issue was... yay!

Thank you Micron, Peter and Joe for all your assistance; much appreciated!! Credit to all of you.

Sub MoveFiles()

Dim NewFile As String

    NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*")
   
    Do While NewFile <> ""
        'Debug.Print NewFile
        If Dir("D:\ParGo\PODS\IMAGES\" & NewFile) = "" Then
            Name "D:\ParGo\PODS\IMAGES\NEW\" & NewFile As "D:\ParGo\PODS\IMAGES\" & NewFile
            NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*")
            Else
                Kill "D:\ParGo\PODS\IMAGES\NEW\" & NewFile
                NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*")
        End If
    Loop

End Sub

 

[Micron]

As written it seems the lack of setting FileName inside the loop would be the issue.

So that seems to have been the case. I probably should have written it that way to make my suggestion more clear. Sorry.