If File Already exists it gives error - moving files to another folder-CodePudding

I have facing an error while executing this code. If a file already exists in a destination folder it gives error. If a file does not exists it smoothly moves the files into the updated Date folder.

Can anyone please help so that in case if a file already exists in the destination folder the code does not give error. It can either replace the file with the new one or it can remain in the Source folder.

Sub moveAllFilesInDateFolder()

 Dim DateFold As String, fileName As String
 Const sFolderPath As String = "E:\Uploading\Source"
 Const dFolderPath As String = "E:\Uploading\Archive"
 DateFold = dFolderPath & "\" & Format(Date, "ddmmyyyy") ' create the folder if it does not exist

 If Dir(DateFold, vbDirectory) = "" Then MkDir DateFold
 fileName = Dir(sFolderPath & "\*.*")
 Do While fileName <> ""
    Name sFolderPath & "\" & fileName As DateFold & "\" & fileName
    fileName = Dir
 Loop
End Sub

This will be much appreciated.

CodePudding user response：

Please, use this updated code. You cannot use Dir (once more) to check the file existence, because it will perturbate the existing loop. So, a VBScript object should be used. And naming will not be done, anymore. Name method is not able to overwrite an existing file:

Sub moveAllFilesInDateFolderIfNotExist()
 Dim DateFold As String, fileName As String, objFSO As Object
 Const sFolderPath As String = "E:\Uploading\Source"
 Const dFolderPath As String = "E:\Uploading\Archive"
 DateFold = dFolderPath & "\" & Format(Date, "ddmmyyyy") ' create the folder if it does not exist

 If Dir(DateFold, vbDirectory) = "" Then MkDir DateFold
 fileName = Dir(sFolderPath & "\*.*")
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 
 Do While fileName <> ""
    If Not objFSO.FileExists(DateFold & "\" & fileName) Then
        Name sFolderPath & "\" & fileName As DateFold & "\" & fileName
    End If
    fileName = Dir
 Loop
End Sub