Auto generate file name when there is an existing same file name

[xiaoying]

Good Afternoon forum community ? I have written codes to auto generate and save letters. Whenever I save the letters, I will include the name of letter and the company that I am generating for. The problem I came across is: if I generate two of the same letters for the same company, my code will auto replace the existing file. Is there any solution whereby the code can auto generate file name when there is an existing file with the same name? For example: The existing file is Nomination Letter - ABC Company. The second file I want to save it as Nomination Letter - ABC Company (2) instead of auto replacing the existing file. Thanks alot!!

Private Sub NominationLetter()
    Dim ws As Worksheet, msWord As Object
    Dim currentRow As Long
    Dim rowCount As Long
    Dim lastRow As Long
    Dim filename As String
    Dim Path1 As String
    
    Path1 = "C:\Edited Letters\"
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Details of Client")
    Set msWord = CreateObject("Word.Application")
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    
    For currentRow = 2 To lastRow
    If Not ws.Rows(currentRow).Hidden Then
    filename = ws.Range("B" & currentRow).Value
    With msWord
        .Visible = True
        .Documents.Open "C:\Nomination letter - template.docx"
        .Activate

        With .ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            .Text = "DATE"
            .Replacement.Text = ws.Range("E" & currentRow).Value

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
        End With
        
        With .ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            .Text = "COMPANY"
            .Replacement.Text = ws.Range("B" & currentRow).Value

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
        End With
        
        With .ActiveDocument.Content.Find
            .ClearFormatting
            .Replacement.ClearFormatting

            .Text = "YEAR END"
            .Replacement.Text = ws.Range("D" & currentRow).Value

            .Forward = True
            .Wrap = 1               'wdFindContinue (WdFindWrap Enumeration)
            .Format = False
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2     'wdReplaceAll (WdReplace Enumeration)
        End With
        msWord.ActiveDocument.SaveAs filename:=Path1 & "Nomination letter - " & filename & ".docx"
        msWord.ActiveDocument.Close
        rowCount = rowCount + 1
    End With
    End If
    Next currentRow
    msWord.Quit
End Sub

 

[jmacleary]

Hello. I suggest that rather than trying to handle duplicates, if you append the date and time to your filename, then each one will be unique (unless you create 2 in the same minute). So, change your code to:

Filename = ws.Range("B" & currentRow).Value + Format(Date, "YYYYMMDD") + Format(Time(), "HHMM")

I have put the date in year, month, day format so that they will be listed in ascending date order, but you could use any format you wish.

 

[xiaoying]

Hello. I suggest that rather than trying to handle duplicates, if you append the date and time to your filename, then each one will be unique (unless you create 2 in the same minute). So, change your code to:

Filename = ws.Range("B" & currentRow).Value + Format(Date, "YYYYMMDD") + Format(Time(), "HHMM")

I have put the date in year, month, day format so that they will be listed in ascending date order, but you could use any format you wish.

Hi John,
Thanks for replying and thanks for your help!! ? Your codes worked but when I am generating those letters, I always generate them in bulk (meaning generating them in the same minute sadly). Even though, I can always format the time to HHMMSS, it would be better if there is a solution to handle duplicates.

 

[jmacleary]

You could add the rowcount to the end as this will be unique per run.

 

[FatBoyClam]

Alternatively, in the section at the top where you have this code:

    For currentRow = 2 To lastRow
    If Not ws.Rows(currentRow).Hidden Then
    filename = ws.Range("B" & currentRow).Value
    With msWord

Replace it with this

Dim vFilenames As Variant, i As Long

For currentRow = 2 To lastRow
    If Not ws.Rows(currentRow).Hidden Then
    filename = ws.Range("B" & currentRow).Value
    If IsEmpty(vFilenames) Then
        ReDim vFilenames(1, 0)
        vFilenames(0, 0) = 1
        vFilenames(1, 0) = filename
    Else
        For i = 0 To UBound(vFilenames, 2)
            If vFilenames(1, i) = filename Then
                vFilenames(0, i) = vFilenames(0, i) + 1
                filename = filename & " (" & vFilenames(0, i) & ")"
                Exit For
            End If
        Next i
        
        If i > UBound(vFilenames, 2) Then
            ReDim Preserve vFilenames(1, i)
            vFilenames(0, i) = 1
            vFilenames(1, i) = filename
        End If
            
    End If

    With msWord

This creates an array in memory of the value of the filename variable and the number of times it's been used. If it's been used more than once, it appends that number in parentheses to the end of the filename variable.

Cheers
Cal

 

[xiaoying]

Alternatively, in the section at the top where you have this code:

    For currentRow = 2 To lastRow
    If Not ws.Rows(currentRow).Hidden Then
    filename = ws.Range("B" & currentRow).Value
    With msWord

Replace it with this

Dim vFilenames As Variant, i As Long

For currentRow = 2 To lastRow
    If Not ws.Rows(currentRow).Hidden Then
    filename = ws.Range("B" & currentRow).Value
    If IsEmpty(vFilenames) Then
        ReDim vFilenames(1, 0)
        vFilenames(0, 0) = 1
        vFilenames(1, 0) = filename
    Else
        For i = 0 To UBound(vFilenames, 2)
            If vFilenames(1, i) = filename Then
                vFilenames(0, i) = vFilenames(0, i) + 1
                filename = filename & " (" & vFilenames(0, i) & ")"
                Exit For
            End If
        Next i
       
        If i > UBound(vFilenames, 2) Then
            ReDim Preserve vFilenames(1, i)
            vFilenames(0, i) = 1
            vFilenames(1, i) = filename
        End If
           
    End If

    With msWord

This creates an array in memory of the value of the filename variable and the number of times it's been used. If it's been used more than once, it appends that number in parentheses to the end of the filename variable.

Cheers
Cal

Thanks Cal!! It works ?

 

[xiaoying]

This thread is closed.