将最后一个文件夹移出文件路径

Question

在过去的两个月中，我一直在自学VBA，但最终我找到了找不到答案的东西。 到目前为止积累的荣誉使我度过了难关！ :)

我正在尝试创建一个子文件夹，如果该文件夹名为“ toolbox”，则该子文件夹将从当前文档的文件路径中删除最后一个文件夹。

Sub mOpenFile()

    aVar() As String


    swbDir = ThisWorkbook.Path
    aVar = Split(swbDir, "\")

    'test and change sWbDir
    If aVar(UBound(aVar)) = "Toolbox" Then
    '--------------------------------------------------
    N = 1
    swbDir = aVar(0)
    Do Until aVar(N) = "Toolbox"
    swbDir = swbDir & "\" & aVar(N)
    '--------------------------------------------------
    Loop
    MsgBox (swbDir)
    End If

    'open file in the folder below "toolbox"
    ChDir swbDir
    Workbooks.Open Filename:=swbDir & "\" & sWbRead
    ActiveCell.Offset(2, 1).Range("A1").Select
End Sub

我认为我的代码本身是正确的，但它不断弹出“声明无效的外部类型块”错误。 我读过类型块，但对我来说全是希腊文。 如何在不知道有多少个元素的情况下确定数组的维数。 我可以不使用类型...终端类型吗？ 到目前为止，我已经能够不使用任何数组而滑行了，但是无论如何，我还是想学一下，确定数组的大小。 ：/

Answer 1

您可能会发现使用Join从数组构建字符串而不是循环更容易。

Sub mOpenFile()

    Dim aVar() As String

    'split the path into an array
    aVar = Split(ThisWorkbook.Path, Application.PathSeparator)

    'if the last element of the array is toolbox
    If aVar(UBound(aVar)) = "Toolbox" Then
        'redim the array to get rid of the last element
        'Preserve is used to keep all the rest of the data intact
        ReDim Preserve aVar(LBound(aVar) To UBound(aVar) - 1)
    End If

    'join the elements of the array into a string
    Debug.Print Join(aVar, Application.PathSeparator)

End Sub

更新资料

我将其转换为要测试的功能。

Function mOpenFile(ByVal sPath As String) As String

    Dim aVar() As String

    'split the path into an array
    aVar = Split(sPath, Application.PathSeparator)

    'if the last element of the array is toolbox
    If aVar(UBound(aVar)) = "Toolbox" Then
        'redim the array to get rid of the last element
        'Preserve is used to keep all the rest of the data intact
        ReDim Preserve aVar(LBound(aVar) To UBound(aVar) - 1)
    End If

    'join the elements of the array into a string
    mOpenFile = Join(aVar, Application.PathSeparator)

End Function

Answer 2

在进一步了解该主题之后，让大家知道。 我想出了这个：

Dim aVar() As string

'Dimensioning
Public sWbSelf, sWbRead, sWbDir  As String

Type PathArray
aVar() As string
End Type


Sub mOpenFile()



'listing variables
    sWbDir = ThisWorkbook.Path
    MsgBox (TypeName(aVar))
    ReDim aVar(UBound(Split(sWbDir, "\")))
    aVar = Split(sWbDir, "\")

'test and change sWbDir
    If aVar(UBound(aVar)) = "Toolbox" Then
    '--------------------------------------------------
    N = 1
    sWbDir = aVar(0)
    Do Until aVar(N) = "Toolbox"
    sWbDir = sWbDir & "\" & aVar(N)
    Loop
    MsgBox (sWbDir)
    End If

 'open file in the folder below "toolbox"
    ChDir sWbDir
    Workbooks.Open Filename:=sWbDir & "\" & sWbRead
    ActiveCell.Offset(2, 1).Range("A1").Select
End Sub

这种方法也很好，但是Dick的代码只花了一点时间。