Before Save - Append Date

[akaUriel]

What I am trying to do is make it so the workbook will save and automatically append the date to the end of the filename, before the extension.

Dim dt As String, wbNam As String

wbNam = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1)
dt = Format(CStr(Now), "mmddyy")
ActiveWorkbook.SaveAs Filename:=wbNam & " " & dt

This is the code I use to save the file, however I can't get it to run off the BeforeSave event.

Any suggestions?

 

[AlphaFrog]

<font face=Courier New><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Workbook_BeforeSave(<SPAN style="color:#00007F">ByVal</SPAN> SaveAsUI <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>, Cancel <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>)<br>    <SPAN style="color:#00007F">Dim</SPAN> dt <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, wbNam As <SPAN style="color:#00007F">String</SPAN><br><br>    wbNam = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1)<br>    dt = Format(Date, "mmddyy")<br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>    Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br>    ActiveWorkbook.SaveAs Filename:=wbNam & " " & dt<br>    Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br>    Cancel = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[wigi]

Hello AlphaFrog,

Although it's good practice to not have . in the name of a workbook, I would use InStrRev instead of InStr.

More important, if you save the file twice (and more), all dates will be continuously added to the filename...

Therefore:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim dt As String, wbNam As String
    wbNam = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 8)
    dt = Format(Date, "mmddyy")
    On Error Resume Next
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=wbNam & " " & dt
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Cancel = True
End Sub

 

[AlphaFrog]

Good catch Wigi.

 

[akaUriel]

Thank you.
Worked perfectly.

Sorry for the delayed response, was called into work.