VBA - 保存工作簿并将今天的日期添加到当前工作簿名称

Question

下面的代码显示了我的保存宏。现在，它将当前工作簿保存在具有当前工作簿名称的特定文件路径中。如何在当前工作簿名称中添加今天的日期？那么它将使用当前工作簿名称和今天的日期保存到指定的文件路径？

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

Answer 1

首先，.Name可能包含也可能不包含文件扩展名，具体取决于文件是否已保存。 （例如“Test.xls”或“Book2”）

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, "yyyy-mm-dd") & Mid(ActiveWorkbook.Name,Pos+1)

Answer 2

只要您使用常见的Excel文件类型，无论文件扩展名是什么（即使没有文件扩展名！），这都应该是可靠的。如果您打开奇怪的.HTML文件，可能需要进行一些调整。

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