VBA - Save macro naming workbook - vba

Question

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" instead of "Workbook Name, Today's Date, Today's Date.xlsm" (Attaching the Date twice to the end of the file name, which is what it does now). 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:\HR\Cole G\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 Pos < 0 Then Pos = Len(ActiveWorkbook.Name)
' Now put everything together, including the file extension...
ActiveWorkbook.SaveAs Path & Left(ActiveWorkbook.Name, Pos) & Format (Now, "d-mm-yyyy") & Mid(ActiveWorkbook.Name, Pos + 1)
End Sub`

Answer 1

You could try a recursive approach like so (not tested):
Sub CreateCopyFile(ByVal oldFileName As String, Optional ByVal copyNo As Long = 1)
If FileLen(oldFileName & " Copy (" & copyNo & ")") Then
CreateCopyFile(oldFileName, copyNo + 1)
Else
ActiveWorkbook.SaveAs oldFileName & " Copy (" & copyNo & ")"
End If
End Sub
Then change your code to the following:
Dim potentialFileName As String
potentialFileName = Path & Left(ActiveWorkbook.Name, Pos) & Format(Now, "d-mm-yyyy") & Mid(ActiveWorkbook.Name, Pos + 1)
If FileLen(potentialFileName) Then
CreateCopyFile(potentialFileName)
Else
ActiveWorkbook.SaveAs potentialFileName
End If
'// rest of code here....
There used to be a cleaner way of doing this using a command prompt, however in recent years it seems that Windows no longer allows the use of it via VBA without changing security settings (which I do not advise...)

Answer 2

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)
use this to save your file