打开当前目录上方的文件夹

Question

我想从我的工作簿目录向上移动到树中的上面的文件夹，甚至上面的两个文件夹。

我在这里找到了一些提示：
Go 上一层文件夹
https://www.mrexcel.com/board/threads/up-directory-level-in-vba.594371/

我开发了这段代码：

Sub folder()
 Dim ParentPath As String
 Dim Path As String
 Path = ThisWorkbook.Path
 ParentPath = Left$(Path, InStrRev(Path, "\"))
 ChDir ".."
End Sub

但是，它仍然会在我的工作簿所在的级别打开文件夹。

Answer 1

您可以创建GetParentFolder(path, level) function 以在定义的级别上返回路径。

用法：

Sub Test()
    Dim sFilePath As String, sParentPath As String
    Dim sPaths As Variant, i As Integer
    sPaths = Array("D:\AAA\BBB\CCC\DDD\", "D:\AAA")
    For i = LBound(sPaths) To UBound(sPaths)
        sFilePath = sPaths(i)
        sParentPath = GetParentFolder(sFilePath, 2)
        MsgBox sFilePath & vbCr & vbCr & sParentPath
    Next i
End Sub

Function GetParentFolder(initialPath As String, Optional levelUp As Integer = 1)
    Dim pf As String, i As Integer, j As Integer
    
    On Error GoTo Exit_GetParentFolder
    
    pf = initialPath
    If Right$(pf, 1) = "\" Then pf = Left(pf, Len(pf) - 1)
    i = 0
    Do While i < levelUp
        j = InStrRev(pf, "\") - 1
        If j < 3 Then j = 3
        pf = Left$(pf, j)
        i = i + 1
    Loop

Exit_GetParentFolder:
    GetParentFolder = pf
End Function

笔记：

Function 在无法升级时返回驱动器号。

Answer 2

如果您使用的是 Windows：

Sub tester()
    Debug.Print MoveUp("C:\Users\tim\Desktop", 2)
End Sub


Function MoveUp(ByVal f As String, Optional levels As Long = 1)
    Dim n As Long
    For n = 1 To levels
        f = CreateObject("scripting.filesystemobject") _
                   .getfolder(f).ParentFolder.Path
    Next n
    MoveUp = f
End Function