VBA

Question

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

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

Answer 1

无论文件扩展名如何（即使没有文件扩展名！），只要您使用常见的 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

Answer 2

首先，.Name 可能包含也可能不包含文件扩展名，具体取决于文件是否已保存。（例如 "Test.xls" 或 "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)

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

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

excel

excel-2010