[SOLVED] VBA Moving Files to New Folder, Rename if File exists in new folder

VBA Moving Files to New Folder, Rename if File exists in new folder

I am trying to move files from one folder to another. If the file name already exists in the new folder, I need to rename with the creation date at then end of the title. Below is what I have so far

Private Sub LetsMove_Click()

Application.ScreenUpdating = False

'Move all files from OldAddressTextBox to NewAddressTextBoxand append the created date to the name if new file title already exists.


Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object, errResult As String
Set mergeObj = CreateObject("Scripting.FileSystemObject")
 

Set dirObj = mergeObj.Getfolder(OldAddressTextBox.Text)
Set filesObj = dirObj.Files
For Each everyObj In filesObj


mergeObj.CopyFolder Source:=OldAddressTextBox.Text, Destination:=NewLocationTextBox.Text

errResult = mergeObj.Rename(mergeObj.CreationDate)

Next

MsgBox "You can find the files and subfolders from " & OldAddressTextBox.Text & " in " & NewLocationTextBox.Text


End Sub

Solution

Try the next code please. I tried keeping your variable names, but they are not the most appropriate, in order to easily debugging the code...

It copies all files form old folder in the newLocation one, with their original name if they do not exist and with creation date (in format "dd.mm.yyy", which can be changed), for the existing one in the target location. Without formatting, the ":" caracter which separates hours, minutes and seconds is not accepted in the path. If you also, need them they can be included, but changing the separator when formatted:

Private Sub LetsMove_Click()
 Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
 Dim newName As String, oldAdressFld As String, NewLocationFld As String
 Dim strExtension As String, objCr, creationDate As String

 oldAdressFld = OldAddressTextBox.text
 NewLocationFld = NewLocationTextBox.text

 Set mergeObj = CreateObject("Scripting.FileSystemObject")
 
 Set dirObj = mergeObj.GetFolder(oldAdressFld)
 Set filesObj = dirObj.Files

 For Each everyObj In filesObj
    If Not mergeObj.FileExists(Replace(everyObj, oldAdressFld, NewLocationFld)) Then
        mergeObj.CopyFile everyObj, Replace(everyObj, oldAdressFld, NewLocationFld)
    Else
        strExtension = "." & mergeObj.GetExtensionName(everyObj)
        Set objCr = mergeObj.GetFile(everyObj)
        creationDate = Format(objCr.DateCreated, "dd.mm.yyyy")
        newName = left(everyObj, Len(everyObj) - Len(strExtension)) & "_" & creationDate & strExtension
        mergeObj.CopyFile everyObj, Replace(newName, oldAdressFld, NewLocationFld)
    End If
 Next

 MsgBox "You can find the files from " & oldAdressFld & " in " & NewLocationFld
End Sub

Looking to your code, I started asking myself if you also need subfolders copying. If yes, it can be done in a similar way, but there are issues to be settled...