vbafilesystemobject

To Replace the File in available in Archive folder with the new one


Below mentioned code is successfully creating an updated "Datewise folder" and it automatically moves the files in it. However i just need a small amendment.

Currently if the file with the same exact name is available in Destination Folder it does not move the file and file stays in Source Folder, however can anyone please help and amend the code so that if a file which is already available in Destination folder and if it comes again in Source folder the code should replace the new file with the previously available 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

Solution

  • Please, try the next updated code. Name does not have a parameter able to make it overwriting. But the code can kill (delete) the file if it exists and use the method after that:

    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
        Else
            kill DateFold & "\" & fileName
            Name sFolderPath & "\" & fileName As DateFold & "\" & fileName
        End If
    
        fileName = Dir
    
     Loop
    
    End Sub