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