Workbook.SaveAs function, appends number to similar named files

[Cheesecube]

Hi, how do you modify the Workbook.SaveAs function to append a number based on whether there are similarly named files in the same folder?

E.g. Set the filename as Output_n.xlsx

If it is the first file that has the name, then save the file as Output_1.xlsx

If it's the second or third file that has the name, save the file as Output_2.xlsx or Output_3.xlsx

If it's the 12th file that has the name, save the file as Output_12.xlsx

and so on

[Paul_Hossler]

Maybe something like this

Option Explicit




'SaveAsUI   Required    Boolean True if the Save As dialog box is displayed due to changes made that need to be saved in the workbook.
'Cancel     Required    Boolean False when the event occurs. If the event procedure sets this argument to True, the workbook isn't saved when the procedure is finished.


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim P As String, N As String, F As String, E As String
    Dim c As Long
    Dim i As Long
    
    SaveAsUI = True
    Cancel = False


    i = InStrRev(ThisWorkbook.Name, ".")
    N = Left(ThisWorkbook.Name, i - 1)
    E = Right(ThisWorkbook.Name, Len(ThisWorkbook.Name) - i)
        
    If Right(N, 2) Like "##" Then
        c = Right(N, 2)
        N = Left(N, Len(N) - 2)
    Else
        c = 0
    End If


    F = Dir(ThisWorkbook.Path & Application.PathSeparator & N & Format(c, "00") & "." & E)


    Do While Len(F) <> 0
        c = c + 1
        F = Dir(ThisWorkbook.Path & Application.PathSeparator & N & Format(c, "00") & "." & E)
    Loop


    Application.EnableEvents = False
    ThisWorkbook.SaveAs ThisWorkbook.Path & Application.PathSeparator & N & Format(c, "00") & "." & E
    Application.EnableEvents = True
    
    ThisWorkbook.Close


End Sub