VBA如何正确提取ThisWorkbook.Name中Format(Date)前的文件名部分

问题背景 #

• 目标工作簿文件名结构为：[动态名称段] [DD-MMM格式日期段] [可选版本后缀]，示例文件名为All PM 7.6 10-Jun v2
• 固定规则：日期段固定通过Format(Date, "DD-MMM")生成，格式为两位数字日期+连字符+三位月份英文缩写，和前后内容以空格分隔
• 原有实现按.分割文件名后拼接前两段，存在两个明显缺陷：
  • 通用性差，动态名称段内的.数量变化时就会提取错误
  • 未处理文件扩展名，工作簿格式变更（如从.xlsm改为.xlsb）时会直接返回错误结果

实现思路 #

放弃依赖分隔符计数的逻辑，直接锚定格式固定的日期段：只要定位到文件名中符合DD-MMM规则的日期段的起始位置，截取该位置之前的内容、去除首尾空格，就是需要的动态名称段。该逻辑完全不受动态段本身的字符（.、空格等）、日期后版本后缀内容的影响。

可直接复用的代码 #

采用正则后期绑定写法，不需要手动添加VBA引用，兼容所有Office版本：

Function ExtractDynamicName() As String
    Dim fileName As String, reg As Object, matchRes As Object
    fileName = ThisWorkbook.Name
    
    ' 先剔除文件扩展名，避免扩展名字符干扰匹配
    If InStrRev(fileName, ".") > 0 Then
        fileName = Left(fileName, InStrRev(fileName, ".") - 1)
    End If
    
    ' 初始化正则
    Set reg = CreateObject("VBScript.RegExp")
    reg.Global = False
    reg.IgnoreCase = True
    ' 匹配规则：前置空格 + 两位数字 + 连字符 + 三位英文字母（月份缩写）+ 单词边界
    reg.Pattern = "\s\d{2}-[A-Za-z]{3}\b"
    
    Set matchRes = reg.Execute(fileName)
    If matchRes.Count = 1 Then
        ' 截取日期前的内容，去除首尾空格
        ExtractDynamicName = Trim(Left(fileName, matchRes(0).FirstIndex))
    Else
        ' 未匹配到标准日期段时的容错，可按需调整返回值
        ExtractDynamicName = fileName
    End If
End Function

调用时直接用strExisting = ExtractDynamicName()即可拿到结果。

方案优势 #

• 无分隔符依赖：不管动态名称段里包含多少个.、空格，都能准确提取
• 后缀兼容：日期后不管加v2、最终版还是其他任意标识，都不影响匹配结果
• 格式兼容：自动剔除文件扩展名，工作簿保存为任意Excel格式都能正常运行
• 自带容错：文件名不符合预期结构时不会抛出运行时错误，默认返回去扩展名的完整文件名

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