Excel宏需求：生成带唯一时间戳的新文件名并添加最后修改用户名

你碰到的核心问题是代码没有从固定的基础文件名出发构建新文件，而是直接在当前已带时间戳的文件名上继续追加，导致每次运行都叠加上新的时间戳。下面是修正后的完整代码，同时满足你要求的「实时生成标准格式文件名」和「添加最后修改用户名」的需求：

完整修正代码 #

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim baseFileName As String
    Dim timeStamp As String
    Dim userName As String
    Dim fullFileName As String
    Dim savePath As String
    
    ' 1. 固定基础文件名，确保每次都从干净的起点构建
    baseFileName = "2018 Test"
    
    ' 2. 生成实时时间戳，严格匹配你要的格式：YYYY.MM.DD_HHMM
    timeStamp = Format(Now(), "YYYY.MM.DD_HHMM")
    
    ' 3. 获取最后修改的用户名（三种可选方式，按需挑一个用）
    ' 方式1：获取Windows系统登录的用户名（最稳定，不受Excel设置影响）
    userName = Environ("Username")
    ' 方式2：获取Excel选项里用户自己设置的名称
    ' userName = Application.UserName
    ' 方式3：获取文件属性中记录的最后修改作者（需文件已保存过一次）
    ' userName = ThisWorkbook.BuiltinDocumentProperties("Last Author").Value
    
    ' 4. 确定保存路径：优先用原文件所在目录，未保存过则默认存桌面
    If ThisWorkbook.Path <> "" Then
        savePath = ThisWorkbook.Path & "\"
    Else
        savePath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
    End If
    
    ' 5. 拼接完整文件名：基础名_时间戳_用户名.xlsx
    fullFileName = savePath & baseFileName & "_" & timeStamp & "_" & userName & ".xlsx"
    
    ' 6. 保存为全新副本（不会修改原文件的内容和状态）
    ThisWorkbook.SaveCopyAs fullFileName
    
    ' 可选：如果关闭原文件时不想保存原文件的修改，取消下面的注释
    ' ThisWorkbook.Saved = True
End Sub

代码关键说明 #

• 固定基础文件名：用baseFileName锁定为"2018 Test"，彻底杜绝了从当前文件名追加的问题，每次都从干净的基础名开始构建新文件。
• 实时时间戳：用Format(Now(), "YYYY.MM.DD_HHMM")生成当前系统时间的格式化字符串，确保每次运行都是最新的时间标记。
• 用户名获取：提供三种常用方式，你可以根据场景选择最适合的：
  • Environ("Username")：对应Windows系统登录账号，不受Excel设置干扰
  • Application.UserName：用户在Excel软件中自行设置的显示名称
  • Last Author：文件属性里记录的最后修改作者（需要文件已经被保存过一次才能读取）
• 路径容错处理：自动判断原文件的保存路径，若文件从未保存过（路径为空），就默认保存到桌面，避免报错。
• 安全保存：用SaveCopyAs生成副本，不会改动原文件的内容和状态，保证原文件的独立性。

测试效果 #

每次关闭工作簿时，都会在指定路径生成一个全新的文件，格式类似：2018 Test_2024.05.20_1542_JR2018.xlsx，完全不会出现重复追加时间戳的问题。

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