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

 

[Joe4]

Have a look here: VBA Check if File or Folder Exists - Automate Excel

 

[JohanGduToit]

Have a look here: VBA Check if File or Folder Exists - Automate Excel

Hi Joe,

Thank you for the link... I am familiar with the Dir functionality; but I am still battling to get my code to work. The code below works, except for if a filename that are to be moved already exist in the Target folder. The current code below will move files; but if it encounters more than one 'duplication' it will only delete one file at a time.

Not sure what to do... I think I might be going wrong with the "NewFile = Dir" statements in the 'else' section or before looping.

Sub MoveFiles()

Dim NewFile As String

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

    Do Until NewFile = ""
        If Dir("D:\ParGo\PODS\IMAGES\" & NewFile) = "" Then
            MsgBox "File " & NewFile & " does not exist in Target Folder, file will be moved..."
            Name "D:\ParGo\PODS\IMAGES\NEW\" & NewFile As "D:\ParGo\PODS\IMAGES\" & NewFile
            NewFile = Dir
            Else
                MsgBox "File " & NewFile & " already exist in Target Folder, file will not be moved and deleted instead..."
                Kill "D:\ParGo\PODS\IMAGES\NEW\" & NewFile
                NewFile = Dir
        End If
        'NewFile = Dir
    Loop

End Sub

 

[Joe4]

Yeah, I am getting some weird errors to. I don't think it likes you deleting the files in a folder as you are trying to loop through them.

So, at the end, should there not be any files left in the "NEW" folder?
And is there any harm in copying over the existing files with the version in the "NEW" folder (are they, in fact, exactly the same)?

If not, then maybe it makes sense to simply copy over ALL the files from the NEW folder.
At once that is done, delete all the files from the NEW folder.

 

[JohanGduToit]

Yeah, I am getting some weird errors to. I don't think it likes you deleting the files in a folder as you are trying to loop through them.

So, at the end, should there not be any files left in the "NEW" folder?
And is there any harm in copying over the existing files with the version in the "NEW" folder (are they, in fact, exactly the same)?

If not, then maybe it makes sense to simply copy over ALL the files from the NEW folder.
At once that is done, delete all the files from the NEW folder.

Hey Joe,

I would have liked to retain the original file in the target folder if any duplications were found; purely to retain the original filename's date and timestamp; but it's not critical I guess. Yes, no files should be left in the 'New' folders once the procedure completes. I will have a look at copying ALL files and then delete everything from the 'NEW' folder afterwards.

Thank you for your help!

 

[Joe4]

Hey Joe,

I would have liked to retain the original file in the target folder if any duplications were found; purely to retain the original filename's date and timestamp; but it's not critical I guess. Yes, no files should be left in the 'New' folders once the procedure completes. I will have a look at copying ALL files and then delete everything from the 'NEW' folder afterwards.

Thank you for your help!

You are welcome.

I am not sure if using the File System Object code in the link I provided would encounter the same issues or not.
Another alternative I thought might be to store all the file names from the directory to an array, and then loop through that array (instead of the directory), as the array would be unaffacted by the file deletions. Here is a link which shows you how to capture all the file names in a folder to an array: How to read the filenames of all the files in a directory into an array

 

[Micron]

If it already exists, that's error 58? and if it can't be found, it's error 52? so you could employ and error handler and the Kill statement. If you don't want a prompt, remove the message box stuff. The important thing is handling the error, one way or another.

'your looping code goes here

errHandler:
Select Case Err.Number
     Case 58
          response = MsgBox("This file exists in target folder. Delete from source folder?", vbOKCancel + vbExclamation)
          If response = vbOK Then
               Kill "C:\full path to source file here" ' this is probably "D:\ParGo\PODS\IMAGES\NEW\" & NewFile
          Else
               Resume exitHere 'return to loop?
          End If
     Case 52
           'code for file doesn't exist, or just use 58 and Else
     Case Else
          MsgBox "Error " & Err.Number & ": " & Err.Description
          Resume exitHere
End Select

End Sub

 

[petertenthije]

Should you not add vbDirectory to the DIR coding to make it work?

So not:
NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*")
If Dir("D:\ParGo\PODS\IMAGES\" & NewFile) = "" Then

But:
NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*", vbDirectory)
If Dir("D:\ParGo\PODS\IMAGES\" & NewFile, vbDirectory) = "" Then

Sub MoveFiles()

Dim NewFile As String

NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*", vbDirectory)           'Source Directory

    Do Until NewFile = ""
        If Dir("D:\ParGo\PODS\IMAGES\" & NewFile, vbDirectory) = "" Then
            MsgBox "File " & NewFile & " does not exist in Target Folder, file will be moved..."
            Name "D:\ParGo\PODS\IMAGES\NEW\" & NewFile As "D:\ParGo\PODS\IMAGES\" & NewFile
            NewFile = Dir
            Else
                MsgBox "File " & NewFile & " already exist in Target Folder, file will not be moved and deleted instead..."
                Kill "D:\ParGo\PODS\IMAGES\NEW\" & NewFile
                NewFile = Dir
        End If
        'NewFile = Dir
    Loop

End Sub

 

[JohanGduToit]

If it already exists, that's error 58? and if it can't be found, it's error 52? so you could employ and error handler and the Kill statement. If you don't want a prompt, remove the message box stuff. The important thing is handling the error, one way or another.

'your looping code goes here

errHandler:
Select Case Err.Number
     Case 58
          response = MsgBox("This file exists in target folder. Delete from source folder?", vbOKCancel + vbExclamation)
          If response = vbOK Then
               Kill "C:\full path to source file here" ' this is probably "D:\ParGo\PODS\IMAGES\NEW\" & NewFile
          Else
               Resume exitHere 'return to loop?
          End If
     Case 52
           'code for file doesn't exist, or just use 58 and Else
     Case Else
          MsgBox "Error " & Err.Number & ": " & Err.Description
          Resume exitHere
End Select

End Sub

Morning Micron,

Thank you for your suggestion... please check out my attempt to apply your suggested error handling code; my current code will succesfully delete one duplicated file; but ignore

Sub MoveFiles()

On Error GoTo errhandler

Dim NewFile As String

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

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

ExitHere:
    Resume Next

errhandler:
    Select Case Err.Number
        Case 58
            Response = MsgBox("This file already exists in the target folder.  Delete file from source folder?", vbOKCancel + vbExclamation)
            If Response = vbOK Then
                Kill "D:\ParGo\PODS\IMAGES\NEW\" & NewFile
                Else
                    Resume ExitHere
            End If
        Case Else
            MsgBox "Error " & Err.Number & " : " & Err.Description
            Resume ExitHere
    End Select
           

End Sub

Should you not add vbDirectory to the DIR coding to make it work?

So not:
NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*")
If Dir("D:\ParGo\PODS\IMAGES\" & NewFile) = "" Then

But:
NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*", vbDirectory)
If Dir("D:\ParGo\PODS\IMAGES\" & NewFile, vbDirectory) = "" Then

Hi Peter,

I created 2x duplicated files in the source folder to test your code; but get an Error 53 "File not Found" on line containing

Kill "D:\Pargo\PODS\IMAGES\NEW\" & NewFile

The 2 'duplicated' files in the source folder were also not deleted.

 

[JohanGduToit]

If it already exists, that's error 58? and if it can't be found, it's error 52? so you could employ and error handler and the Kill statement. If you don't want a prompt, remove the message box stuff. The important thing is handling the error, one way or another.

'your looping code goes here

errHandler:
Select Case Err.Number
     Case 58
          response = MsgBox("This file exists in target folder. Delete from source folder?", vbOKCancel + vbExclamation)
          If response = vbOK Then
               Kill "C:\full path to source file here" ' this is probably "D:\ParGo\PODS\IMAGES\NEW\" & NewFile
          Else
               Resume exitHere 'return to loop?
          End If
     Case 52
           'code for file doesn't exist, or just use 58 and Else
     Case Else
          MsgBox "Error " & Err.Number & ": " & Err.Description
          Resume exitHere
End Select

End Sub

Hi Micron,

I'm battling to apply the error handling code... current code below; please amend where applicable. Getting an Error 53 "File Not Found" on the "Kill" line when there are duplications (I created two duplicate filenames in the source folder that already exist in the target folder). The two 'duplicated' files are also not getting deleted in the source folder.

Thank you once again for your assistance!

Sub MoveFiles()

On Error GoTo ERR_HANDLER

Dim NewFile As String

NewFile = Dir("D:\ParGo\PODS\IMAGES\NEW\*.*", vbDirectory) 'Source Directory

Do Until NewFile = ""
If Dir("D:\ParGo\PODS\IMAGES\" & NewFile, vbDirectory) = "" Then
MsgBox "File " & NewFile & " does not exist in Target Folder, file will be moved..."
Name "D:\ParGo\PODS\IMAGES\NEW\" & NewFile As "D:\ParGo\PODS\IMAGES\" & NewFile
NewFile = Dir
Else
MsgBox "File " & NewFile & " already exist in Target Folder, file will not be moved but deleted from Source Folder instead..."
Kill "D:\ParGo]\PODS\IMAGES\NEW\" & NewFile
NewFile = Dir
End If
Loop

'Code below from MICRON on MrExcel
ExitAndContinueLoop:
Resume Next

ExitHere:
Exit Sub

ERR_HANDLER:
Select Case Err.Number
Case 58
Response = MsgBox("This file already exists in the target folder. Delete file from source folder?", vbOKCancel + vbExclamation)
If Response = vbOK Then
Kill "D:\ParGo\PODS\IMAGES\NEW\" & NewFile
Else
Resume ExitAndContinueLoop
End If
Case Else
MsgBox "Error " & Err.Number & " : " & Err.Description
Resume ExitHere
End Select

End Sub