Word VBA宏动态打开同目录下符合命名规则的Excel文件方法

场景前提 #

• 带宏的Word文档、待打开的Excel文件存储在同一文件夹
• 路径示例：C:/.../123 - 345823847/123 - OTE.xlsx
• 命名规则：目标Excel文件名的数字前缀，和父文件夹名称开头的数字段完全一致，固定后缀为 - OTE.xlsx

方案1：提取父文件夹数字段拼接路径 #

严格匹配现有命名规则，不会误匹配其他文件，稳定性更高。
完整可运行代码：

Sub SuperMacroFV()
    Dim ExcelApp As Object
    Dim wb_datos As Object
    Dim parentPath As String
    Dim parentFolderName As String
    Dim numPrefix As String
    Dim targetPath As String
    Dim nameSeg As Variant
    
    ' 启动Excel进程
    Set ExcelApp = CreateObject("Excel.Application")
    ExcelApp.Visible = True
    
    ' 获取当前文档所在父文件夹信息
    parentPath = ActiveDocument.Path
    parentFolderName = Mid(parentPath, InStrRev(parentPath, "\") + 1)
    
    ' 提取文件夹名中第一个" - "分隔符前的数字段
    nameSeg = Split(parentFolderName, " - ")
    If UBound(nameSeg) < 0 Then
        MsgBox "父文件夹命名不符合规则，无法提取数字前缀", vbExclamation
        GoTo ClearProcess
    End If
    numPrefix = Trim(nameSeg(0))
    
    ' 拼接目标文件路径
    targetPath = parentPath & "\" & numPrefix & " - OTE.xlsx"
    
    ' 校验文件存在性
    If Dir(targetPath) = "" Then
        MsgBox "未找到目标文件，路径：" & targetPath, vbExclamation
        GoTo ClearProcess
    End If
    
    ' 打开目标Excel
    Set wb_datos = ExcelApp.Workbooks.Open(targetPath)
    Exit Sub

' 错误兜底：关闭残留Excel进程
ClearProcess:
    ExcelApp.Quit
    Set ExcelApp = Nothing
End Sub

核心逻辑：

• 通过InStrRev定位路径最后一个斜杠位置，截取得到父文件夹名称
• 用Split按固定分隔符切割文件夹名，取第一段得到匹配的数字前缀
• 所有异常分支统一走资源回收逻辑，不会残留后台运行的Excel进程

方案2：通配符匹配同目录下后缀为OTE.xlsx的文件 #

无需解析文件夹名称，只要目标文件固定以OTE.xlsx结尾即可命中，适配命名规则调整的场景。
完整可运行代码：

Sub SuperMacroFV()
    Dim ExcelApp As Object
    Dim wb_datos As Object
    Dim currentPath As String
    Dim targetFileName As String
    Dim targetPath As String
    
    ' 启动Excel进程
    Set ExcelApp = CreateObject("Excel.Application")
    ExcelApp.Visible = True
    
    currentPath = ActiveDocument.Path
    ' 遍历当前目录，查找文件名以OTE.xlsx结尾的文件
    targetFileName = Dir(currentPath & "\*OTE.xlsx")
    
    If targetFileName = "" Then
        MsgBox "当前目录下未找到符合规则的OTE.xlsx文件", vbExclamation
        GoTo ClearProcess
    End If
    
    targetPath = currentPath & "\" & targetFileName
    ' 打开目标Excel
    Set wb_datos = ExcelApp.Workbooks.Open(targetPath)
    Exit Sub

' 错误兜底：关闭残留Excel进程
ClearProcess:
    ExcelApp.Quit
    Set ExcelApp = Nothing
End Sub

注意事项：

• 通配符*可匹配任意长度字符，只要文件名末尾为OTE.xlsx就会被选中
• 如果同目录下存在多个符合后缀规则的文件，默认打开Dir遍历返回的第一个文件，需要更精准匹配可以在获取到文件名后增加一层校验逻辑

内容的提问来源于stack exchange，提问作者Javi Martínez