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

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

2 个答案: