Save with a different name if the file already exists in directory

Question

I don't know where I am wrong with this code.

If Dir(FILE_PATH & personList(i, 1) & FILE_EXT) <> "" Then
    .SaveAs2 FILE_PATH & "1" & personList(i, 1) & FILE_EXT
    .Close
Else
    .SaveAs2 FILE_PATH & personList(i, 1) & FILE_EXT
    .Close
End If

Everything just works fine, but when I encounter the same value in a column (for example: John Doe, John Doe), the program overwrites the first John Doe file.

Answer 1

If FileLen(FILE_PATH & personList(i, 1) & FILE_EXT) > 0 Then
    '// File Exists, change name accordingly.
Else
    '// File doesn't exist, save as is.
End If

Answer 2

Here is the function for creating unique filepath (taken from http://mielk.pl/):

Public Function uniqueFilePath(filepath As String) As String
    Const METHOD_NAME As String = "uniqueFilePath"
    '------------------------------------------------------------------------------------------------------
    Static objFSO As Object                 '(Late binding that allows to use the function, even if
                                            'Microsoft Scripting Runtime library is not loaded)
    Dim strFileExtension As String
    Dim strFileName As String
    Dim strParentFolder As String
    Dim strTempFilePath As String
    Dim intCounter As Integer
    '------------------------------------------------------------------------------------------------------



    'Create FileSystemObject instance if it hasn't been created yet. ------------------------------------|
    If objFSO Is Nothing Then                                                                           '|
        Set objFSO = VBA.CreateObject("Scripting.FileSystemObject")                                     '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


    With objFSO

        'Checks if the file already exists. -------------------------------------------------------------|
        If .fileExists(filepath) Then                                                                   '|
                                                                                                        '|
            'If the given filepath already exists, function transforms its name by                      '|
            'appending the number in brackets.                                                          '|
            strParentFolder = .GetParentFolderName(filepath)                                            '|
            If Not VBA.right$(strParentFolder, 1) = "\" Then strParentFolder = strParentFolder & "\"    '|
            strFileName = .GetBaseName(filepath)                                                        '|
            strFileExtension = "." & .GetExtensionName(filepath)                                        '|
                                                                                                        '|
            '------------------------------------------------------------------------------------|      '|
            Do                                                                                  '|      '|
                intCounter = intCounter + 1                                                     '|      '|
                strTempFilePath = strParentFolder & strFileName & _
                                                " (" & intCounter & ")" & strFileExtension      '|      '|
            Loop While .fileExists(strTempFilePath)                                             '|      '|
            '------------------------------------------------------------------------------------|      '|
                                                                                                        '|
            uniqueFilePath = strTempFilePath                                                            '|
                                                                                                        '|
        Else                                                                                            '|
                                                                                                        '|
            'Specified filepath is unique in the file system and is returned in its original form.      '|
            uniqueFilePath = filepath                                                                   '|
                                                                                                        '|
        End If                                                                                          '|
        '-------- [If .FileExists(filepath) Then] -------------------------------------------------------|

    End With


End Function

In order to make the code below work properly you must paste it in your code.

If the filepath you give as a parameter already exists, function returns the same filepath with the number in bracket appended, i.e. if file "C:\file.xlsx" already exists function returns "C:\file (1).xlsx".

If this file doesn't exists the function returns the original filepath without any changes.

Replace all the code you pasted in your question with the below:

Dim filepath As String

filepath = uniqueFilePath(FILE_PATH & personList(i, 1) & FILE_EXT)
Call .SaveAs(filepath)
Call .Close

Answer 3

A lot of these are very long answers for what seems like a pretty simple issue. Most reference a FileSystemObject; which I notice you have not referenced.

My solution would be to use WHILE instead of IF

While Dir(FILE_PATH & personList(i, 1) & FILE_EXT) <> ""
    i = i + 1
Wend
.SaveAs2 FILE_PATH & i & "1" & personList(i, 1) & FILE_EXT
.Close

This preserves the "1" you have in your initial code when the file does not already exists. It also means that you can have a few thousand duplicate names in your list since the first John Doe's file would be named "11John Doe", the second would be "21John Doe", then "31John Doe", etc. Much lighter code that doesn't start implementing new libraries.

Answer 4

Here's a function you can use to retrieve a unique file name for any given path. It will suffix the filename with a " - n", where n is a sequential number.

Function GetNextAvailableName(ByVal strPath As String) As String

    With CreateObject("Scripting.FileSystemObject")

        Dim strFolder As String, strBaseName As String, strExt As String, i As Long
        strFolder   = .GetParentFolderName(strPath)
        strBaseName = .GetBaseName(strPath)
        strExt      = .GetExtensionName(strPath)

        Do While .FileExists(strPath)
            i = i + 1
            strPath = .BuildPath(strFolder, strBaseName & " - " & i & "." & strExt)
        Loop

    End With

    GetNextAvailableName = strPath

End Function

Assuming the file c:\path\to\file.ext exists, the following call:

Debug.Print GetNextAvailableName("c:\path\to\file.ext")

would print:

c:\path\to\file - 1.ext

Answer 5

I've had this function hanging around for an age - not sure where I got it from though. It will pause if the file name hasn't got an extension, or there's more than 100 files with the same base name:

Sub test()

    Debug.Print GenerateUniqueName("S:\Bartrup-CookD\New Folder\Book1.xlsm")

End Sub

'----------------------------------------------------------------------
' GenerateUniqueName
'
'   Generates a file name that doesn't exist by appending a number
'   in between the base name and the extension.
'   Example: GenerateUniqueName("c:\folder\file.ext") = "c:\folder\file4.ext"
'----------------------------------------------------------------------
Function GenerateUniqueName(FullFileName As String, Optional fAlwaysAddNumber As Boolean) As String

    Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject")

    If Not objFSO.FileExists(FullFileName) And Not fAlwaysAddNumber Then
        GenerateUniqueName = FullFileName
    Else
        Dim strExt As String
        Dim strNonExt As String
        Dim strNewName As String
        Dim i As Integer
        strExt = objFSO.GetExtensionName(FullFileName)
        Debug.Assert strExt <> ""
        strNonExt = objFSO.BuildPath(objFSO.GetParentFolderName(FullFileName), objFSO.GetBaseName(FullFileName))
        Do
            Debug.Assert i < 100
            i = i + 1
            strNewName = strNonExt & i & "." & strExt

        Loop While objFSO.FileExists(strNewName)
        GenerateUniqueName = strNewName
    End If
End Function

Answer 6

I use something very similar, for upissuing documents. Could see if you can change this to your needs

Rechecker:
Filename = Sheets("Word_Front").Range("N142").Value
If Not (Update_Only) Then
    If Dir(sDocPath & Filename & Cert & ".docx") <> "" Then
        iret = MsgBox("Existing file found with this filename, Answer YES to up-issue the file. Please note there is no further warning and NO to overwrite the file.", vbYesNo)
        If iret = 6 Then
            Sheets("Word_Front").Range("Q7").Value = Sheets("Word_Front").Range("Q7").Value + 1
            GoTo Rechecker
        Else
            oDoc.SaveAs sDocPath & Filename & Cert & ".docx", 16
        End If
    Else
        oDoc.SaveAs sDocPath & Filename & Cert & ".docx", 16
    End If
End If