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

EN

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)

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