CODEWITHSUNDEEP
vbaexcel
Dane Cameron
Dane Cameron

Reputation: 433

VBA - Save macro naming workbook

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:\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 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`

Upvotes: 1

Views: 122

Answers (2)

SierraOscar
SierraOscar

Reputation: 17647

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...)

Upvotes: 1

Srijan
Srijan

Reputation: 152

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

Upvotes: 0

Related Questions