VBA to add number to file if already exists

[NateD1]

Hi All,
I have the below code which imports a file to an access DB then adds the date to the file and moves the imported file to an archive folder.
I would like to add additional code that recognises if the file being moved already exists with the same date and to save a version 2. so essentially add a number to the end of the file name & date when moving if a duplicate. could someone suggest a code that does this? thanks!

Function Import()

On Error GoTo ImportTaskDataFiles_Err
Dim objFS As Object, objFolder As Object
Dim objFiles As Object, objF1 As Object
Dim strFolderPath As String

strFolderPath = "\filelocation\CSV\"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strFolderPath)
Set objFiles = objFolder.files
  
'Import Txt Files
For Each objF1 In objFiles
If Right(objF1.Name, 3) = "txt" Then

'Add todays date and move file to Archive
    Name strFolderPath & objF1.Name As "\\filelocation\Archive\" & Format(Now, "YYYY-MM-DD ") & objF1.Name
'can the additional code recognises this file already exists with that date and add version control to it?
End If
Next

Set objF1 = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objFS = Nothing

MsgBox ("Done")

 

[Georgiboy]

Perhaps the below will help with numbering the duplicated files: 1, 2, 3, etc...

    Dim objFS As Object, objFolder As Object
    Dim objFiles As Object, objF1 As Object
    Dim strFolderPath As String
    Dim strArchivePath As String
    Dim z As Long
    
    strFolderPath = "\filelocation\CSV\"
    strArchivePath = "\\filelocation\Archive\"
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFS.GetFolder(strFolderPath)
    Set objFiles = objFolder.Files
    z = 2
      
    'Import Txt Files
    For Each objF1 In objFiles
        If Right(objF1.Name, 3) = "txt" Then
            'Add todays date and move file to Archive
            If Not objFS.fileexists(strArchivePath & Format(Now, "YYYY-MM-DD ") & objF1.Name & " - 1") Then
                Name strFolderPath & objF1.Name As strArchivePath & Format(Now, "YYYY-MM-DD ") & objF1.Name & " - 1"
            Else
                Do While objFS.fileexists(strArchivePath & Format(Now, "YYYY-MM-DD ") & objF1.Name & " - " & z)
                    z = z + 1
                Loop
                Name strFolderPath & objF1.Name As strArchivePath & Format(Now, "YYYY-MM-DD ") & objF1.Name & " - " & z
            End If
        End If
    Next
    
    Set objF1 = Nothing
    Set objFiles = Nothing
    Set objFolder = Nothing
    Set objFS = Nothing

    MsgBox ("Done")

 

[eiloken]

with this example, i check that file path already exist and file last modified is today then change file path:

If objFS.FileExists("your file path" & "File extension") And objFS.GetFile("your file path" & "File extension").DateLastModified = Date Then
    For i = 1 To 99
        filepath = "your file path" & " (" & i & ")" & "File extension"
        If Not objFS.FileExists(filepath) And Not objFS.GetFile(filepath).DateLastModified = Date Then
            'rename file
            Exit For
        End If
    Next i
End If

 

[Georgiboy]

Update:
I missed resetting z back to 2 after moving the file:

    Dim objFS As Object, objFolder As Object
    Dim objFiles As Object, objF1 As Object
    Dim strFolderPath As String
    Dim strArchivePath As String
    Dim z As Long
    
    strFolderPath = "\filelocation\CSV\"
    strArchivePath = "\\filelocation\Archive\"
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFS.GetFolder(strFolderPath)
    Set objFiles = objFolder.Files
    z = 2
      
    'Import Txt Files
    For Each objF1 In objFiles
        If Right(objF1.Name, 3) = "txt" Then
            'Add todays date and move file to Archive
            If Not objFS.fileexists(strArchivePath & Format(Now, "YYYY-MM-DD ") & objF1.Name & " - 1") Then
                Name strFolderPath & objF1.Name As strArchivePath & Format(Now, "YYYY-MM-DD ") & objF1.Name & " - 1"
            Else
                Do While objFS.fileexists(strArchivePath & Format(Now, "YYYY-MM-DD ") & objF1.Name & " - " & z)
                    z = z + 1
                Loop
                Name strFolderPath & objF1.Name As strArchivePath & Format(Now, "YYYY-MM-DD ") & objF1.Name & " - " & z
                z = 2
            End If
        End If
    Next
    
    Set objF1 = Nothing
    Set objFiles = Nothing
    Set objFolder = Nothing
    Set objFS = Nothing

    MsgBox ("Done")

 

[NateD1]

@Georgiboy amazing thankyou! is there a way to reorder the wording when its moved as it appears like this - 2023-10-23 Daily.txt - 1 and the file doesn't save as a text file due to the number being after .txt
can it be 2023-10-23 Daily -1.txt or 2023-10-23 -1 Daily.txt instead?

 

[Georgiboy]

You could edit the middle part to:

    'Import Txt Files
    For Each objF1 In objFiles
        If Right(objF1.Name, 3) = "txt" Then
            'Add todays date and move file to Archive
            If Not objFS.fileexists(strArchivePath & Format(Now, "YYYY-MM-DD ") & " - 1 " & objF1.Name) Then
                Name strFolderPath & objF1.Name As strArchivePath & Format(Now, "YYYY-MM-DD ") & " - 1 " & objF1.Name
            Else
                Do While objFS.fileexists(strArchivePath & Format(Now, "YYYY-MM-DD ") & " - " & z & " " & objF1.Name)
                    z = z + 1
                Loop
                Name strFolderPath & objF1.Name As strArchivePath & Format(Now, "YYYY-MM-DD ") & " - " & z & " " & objF1.Name
                z = 2
            End If
        End If
    Next