Search code examples
vbaexcel

VBA - Saving multiple copies of a workbook with a specific naming convention


I have code below to save the current workbook and attach today's date to the end of the file name. How would I modify the code so if two copies of the workbook were to be saved on the same day, the first one would save normally as "Workbook Name, Today's Date.xlsm" and the second one would save as "Workbook Name, Today's Date Copy 2.xlsm". Same thing if the workbook were to be saved 3,4,5 times a day they should save as Copy 3,4,5,etc...

Sub Save_Workbook()

Const Path = "H:\Username\Timehseet Test Path\"
Dim FileName As String
Dim Pos As Long

Pos = InStrRev(ActiveWorkbook.Name, ".") - 1
' If there wasn't a ".", then the file doesn't have an extension and Pos = -1

If Dir(Path & Left(ActiveWorkbook.Name, Pos) & Format(Now, "d-mm-yyyy") & Mid(ActiveWorkbook.Name, Pos + 1)) <> "" Then
    ActiveWorkbook.SaveAs FileName:=Path & Left(ActiveWorkbook.Name, Pos) & "copy 2" & Mid(ActiveWorkbook.Name, Pos + 1)
Else
    ActiveWorkbook.SaveAs FileName:=Path & Left(ActiveWorkbook.Name, Pos) & Format(Now, "d-mm-yyyy") & Mid(ActiveWorkbook.Name, Pos + 1)

End If
End Sub

Solution

  • Instead of appending "Copy xxx", why not to append the time? eg

     "Workbook Name, 2018-04-05 12.30.23.xlsm"