CODEWITHSUNDEEP
excelvbaexcel-2010
Dane Cameron
Dane Cameron

Reputation: 423

VBA - save workbook and add today's date to current workbook name

The code below shows my save macro. Right now it saves the current workbook in a specific file path with the current workbook name. How can I add today's date in the current workbook name? So it saves to the designated file path with the current workbook name and today's date on the end?

Sub Save_Workbook()
    ActiveWorkbook.SaveAs "H:\HR\Username\Timehseet Test Path\" & ActiveWorkbook.Name
End Sub

Upvotes: 1

Views: 12948

Answers (2)

Profex
Profex

Reputation: 1390

First off, .Name may or may not include a file extension, depending on if the file has been saved or not. (eg. "Test.xls" or "Book2")

Const Path = "H:\HR\Cole G\Timehseet Test Path\"
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, "yyyy-mm-dd") & Mid(ActiveWorkbook.Name,Pos+1)

Upvotes: 3

David Zemens
David Zemens

Reputation: 53623

This should be reliable regardless of file extension (even if there is no file extension!), as long as you're using common Excel file types. If you're opening weird .HTML files it may need some tweaking.

Sub Save_Workbook()
    Dim fileNameWithoutExtension as String
    fileNameWithoutExtension = getFileNameWithoutExtension(ActiveWorkbook)
    ActiveWorkbook.SaveAs "H:\HR\Cole G\Timehseet Test Path\" & fileNameWithoutExtension & Format(Date, "YYYY-MM-DD"), FileFormat:=ActiveWorkbook.FileFormat
End Sub

Function getFileNameWithoutExtension(wb As Workbook)
Dim baseName As String

If (wb.Name = wb.FullName) Then
    ' This handles files that have not been saved, which won't have an extension
    baseName = wb.Name
    GoTo EarlyExit
End If

Select Case wb.FileFormat
    Case xlOpenXMLAddIn, xlOpenXMLStrictWorkbook, xlOpenXMLTemplate, xlOpenXMLTemplateMacroEnabled, _
        xlOpenXMLWorkbook, xlWorkbookDefault
        ' These all have a 4-character extension
        baseName = Left(wb.Name, Len(wb.Name) - 5)
    Case Else
        ' almost every other file type is a 3-character extension,
        ' but modify if needed based on this enumeration:
        ' https://msdn.microsoft.com/en-us/vba/excel-vba/articles/xlfileformat-enumeration-excel
        baseName = Left(wb.Name, Len(wb.Name) - 4)
End Select

EarlyExit:
getFileNameWithoutExtension = baseName

End Function

Upvotes: 1

Related Questions