VBA动态获取当前工作簿上一级路径的实现方法

没问题，我来帮你搞定这个需求！你已经用Path = ThisWorkbook.Path拿到了当前工作簿的路径，要获取上一级路径PathBefore，这里有两种实用且可靠的方法，适配不同场景：

方法1：使用FileSystemObject（推荐，兼容性更强） #

这个方法依赖VBA的文件系统对象，能自动处理Windows和Mac系统不同的路径分隔符（\或/），逻辑更稳健，不容易出错。

你可以直接用后期绑定（不需要额外引用库，更方便），代码片段整合到你的Initialize过程里就行：

Sub Initialize()
    Dim MainWB As Workbook
    Dim MainSheet As Worksheet
    Dim SLRow As Long
    Dim Path As String
    Dim PathBefore As String
    Dim fso As Object ' 后期绑定FileSystemObject
    
    Set MainWB = ThisWorkbook
    Set MainSheet = MainWB.Worksheets("Main")
    SLRow = MainWB.Worksheets("SAP").Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 先判断工作簿是否已保存（未保存的话Path为空）
    If MainWB.Path = "" Then
        MsgBox "请先保存当前工作簿，才能获取路径！"
        Exit Sub
    End If
    
    Path = MainWB.Path
    
    ' 创建FileSystemObject实例
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' 直接获取上一级路径
    PathBefore = fso.GetParentFolderName(Path)
    
    ' 额外：拼接你要保存的指定文件夹路径，不存在则创建
    Dim TargetFolder As String
    TargetFolder = fso.BuildPath(PathBefore, "你的指定文件夹名")
    If Not fso.FolderExists(TargetFolder) Then
        fso.CreateFolder TargetFolder
    End If
    
    ' 这里可以继续写保存模板文件的逻辑，用TargetFolder作为目标路径
    
    ' 释放对象
    Set fso = Nothing
    Set MainSheet = Nothing
    Set MainWB = Nothing
End Sub

fso.GetParentFolderName(Path)会直接返回传入路径的上一级目录，不管路径格式如何都能正确识别。

方法2：用VBA内置函数（无需额外对象） #

如果不想用FileSystemObject，也可以用Left和InStrRev组合截取路径，纯靠VBA原生函数实现：

Sub Initialize()
    Dim MainWB As Workbook
    Dim MainSheet As Worksheet
    Dim SLRow As Long
    Dim Path As String
    Dim PathBefore As String
    Dim SepPos As Long
    
    Set MainWB = ThisWorkbook
    Set MainSheet = MainWB.Worksheets("Main")
    SLRow = MainWB.Worksheets("SAP").Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 先判断工作簿是否已保存
    If MainWB.Path = "" Then
        MsgBox "请先保存当前工作簿，才能获取路径！"
        Exit Sub
    End If
    
    Path = MainWB.Path
    
    ' 找到最后一个路径分隔符的位置（兼容Windows的\和Mac的/）
    SepPos = InStrRev(Path, "\")
    If SepPos = 0 Then SepPos = InStrRev(Path, "/")
    
    ' 截取上一级路径
    If SepPos > 0 Then
        PathBefore = Left(Path, SepPos - 1)
    Else
        MsgBox "当前路径已是根目录，无法获取上一级路径"
        Exit Sub
    End If
    
    ' 额外：拼接指定文件夹路径并创建
    Dim TargetFolder As String
    TargetFolder = PathBefore & Application.PathSeparator & "你的指定文件夹名"
    If Dir(TargetFolder, vbDirectory) = "" Then
        MkDir TargetFolder
    End If
    
    ' 后续保存模板文件的逻辑
    
    Set MainSheet = Nothing
    Set MainWB = Nothing
End Sub

这个方法不用创建额外对象，适合轻量化场景，但需要手动处理不同系统的路径分隔符。

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