从文件路径中取出最后一个文件夹

过去两个月我一直在教自己的VBA，最后我发现了一些我找不到答案的东西。荣誉堆栈溢出为我带来迄今为止！ :)从文件路径中取出最后一个文件夹

我想做一个子文件夹，如果该文件夹被命名为“工具箱”，将最后一个文件夹移出当前文档的文件路径。

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

我想我的代码本身是正确的，但它一直弹出一个“声明无效的外部类型块”错误。我已经读过类型块，但这对我来说都是希腊文。如何在不知道有多少元素的情况下对数组进行维度定位。我可以在没有类型...结束类型的情况下执行吗？我已经能够滑动到目前为止没有使用任何数组，但这是我想要学习的东西，尺寸化我的数组。：/

来源

2014-04-30 ComputerNerd3579617

'aVar（）As String' - >'Dim aVar（）As String'。此外，似乎你有无限循环：'直到aVar（N）=“工具箱”'。你是否应该在循环中增加'N'：'N = N + 1'？ –

可能重复？ http://stackoverflow.com/questions/4326678/dynamically-dimensioning-a-vba-array – RubberDuck

Dimensionaing变量需要'Dim'关键字（或'ReDim'）。 –

您可能会发现使用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

results of test in immediate window

来源

2014-04-30 13:46:04

这是一个好主意。它至少让我摆脱了使用循环，我听到更多的时间和内存消耗。但是，我在我的excel程序中试过了你的代码，它并没有删除字符串中的最后一个元素。它返回与ThisWorkbook.Path相同的字符串。在您的ReDim之后，VBA ReDims可能会自动启动吗？太糟糕的连接没有像split这样的[Limit as Long]参数。我在想有人应该写信给微软这件事！ – ComputerNerd3579617

你是说If语句返回TRUE，但不删除最后一个元素？我不认为这是可能的。如果它返回的是初始路径，那么它必须是最后一个子文件夹不是Toolbox。这种比较是区分大小写的，所以也许就是这样。 –

没有。这是我检查的第一件事。我在If块中放了一个断点，果然，它触发了。当您输入变量并对其进行测试时，此代码是否适用于您？ – ComputerNerd3579617

只是为了让你们都知道，多看一些关于这个问题之后。我想出了这个：

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

这种方式也可以，但迪克的代码只花了一点时间。

来源

2014-05-01 10:52:51 ComputerNerd3579617

从文件路径中取出最后一个文件夹

回答

相关问题