如何用VBA为工作簿标题添加后缀并保存至原文件夹？

原代码的问题 #

你测试的代码ActiveWorkbook.SaveAs ThisWorkbook.Path & Filename = "Worked"存在两个核心错误：

• 参数格式错误：SaveAs方法需要传入完整的文件路径+文件名，而不是语法错误的拼接字符串
• 逻辑错误：直接将文件名设为Worked，没有实现“在原文件名后添加后缀”的需求

正确实现代码 #

下面的代码会自动在原文件名末尾添加Worked后缀，并保存到原文件夹：

Sub SaveWorkedVersion()
    ' 声明变量
    Dim originalPath As String
    Dim originalName As String
    Dim fileExt As String
    Dim newFileName As String
    Dim fullSavePath As String
    
    ' 获取当前工作簿的原路径（确保工作簿已保存过，否则Path为空）
    originalPath = ActiveWorkbook.Path
    If originalPath = "" Then
        MsgBox "请先保存当前工作簿，再运行此宏！"
        Exit Sub
    End If
    
    ' 拆分原文件名和扩展名
    originalName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
    fileExt = Right(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - InStrRev(ActiveWorkbook.Name, "."))
    
    ' 拼接新文件名（原文件名 + " Worked" + 扩展名）
    newFileName = originalName & " Worked." & fileExt
    
    ' 拼接完整保存路径
    fullSavePath = originalPath & "\" & newFileName
    
    ' 保存工作簿，保留原文件格式
    ActiveWorkbook.SaveAs Filename:=fullSavePath, FileFormat:=ActiveWorkbook.FileFormat
    
    ' 可选：提示保存完成
    MsgBox "已保存为：" & newFileName
End Sub

代码说明 #

• InStrRev(ActiveWorkbook.Name, ".")：找到文件名中最后一个.的位置，用来区分文件名和扩展名（兼容多后缀格式）
• ActiveWorkbook.FileFormat：保存时使用原工作簿的格式，避免格式变更（比如xlsm格式不会变成xlsx）
• 增加了空路径判断：如果工作簿从未保存过，会弹出提示，避免报错

注意事项 #

• 如果你的宏是在另一个工作簿中运行，而非当前处理的报表工作簿，需要将ActiveWorkbook替换为对应的工作簿对象（比如Workbooks("报表.xlsx")）
• 若要在文件名和Worked之间不加空格，只需修改newFileName = originalName & "Worked." & fileExt即可

内容的提问来源于stack exchange，提问作者SomeKindaRookie