急求：如何枚举到某文件夹下的最底层子文件夹（且只要最底层）

[lpide619689]

菜鸟
某文件夹下面有很多子文件夹，然后子文件夹下面又包含很多子文件夹......而且这样多次....
比如c:/01/ 下面又 a b c 子文件夹。 然后a 下面又有1 2 3 子文件夹。。。
现在我只想要遍历获取到所有最底层子文件夹（且只要最底层，其它的全部不要，子文件夹路径，文件名也也不要。），含完整路径。
最好是用 Dir 速度快是不？
非常感谢！

[舉杯邀明月]

你这个说的有点模糊啊，看样子，是有可能要返回很多个文件夹路径？ 还有，并列的、但“层次深度”不相同的，算不算需要返回的呢？ 就拿你在主贴中的“C:\01”的例子来说：

C:\01
C:\01\a
C:\01\a\1
C:\01\a\2
C:\01\a\3
C:\01\b
C:\01\c

这种情况下，是只返回3、4、5这三项，还是3到7这５项？ 毕竟，从6、7这两条路径来说，它也算各自的“最底层”。 另外一种再复杂点的情况：

C:\01
C:\01\a
C:\01\a\1
C:\01\a\2
C:\01\a\3\x\y
C:\01\b
C:\01\c\w

这时返回的是3到7？　还是5和7？　或者只能是5？ 所以，从你的含糊的问题描述，根本就搞不清楚你要的是什么结果。

[Tiger_Zhao]

Option Explicit

Sub Main()
    Dim oLeafDir    As Collection
    Dim i           As Long
    
    Set oLeafDir = GetLeafDirectory("c:\01\")

    Debug.Print "== Leaf =="
    For i = 1 To oLeafDir.Count
        Debug.Print oLeafDir(i)
    Next
End Sub

Function GetLeafDirectory(ByVal Path As String) As Collection
    Dim oLeafDir    As Collection
    Dim oStackDir   As Collection
    Dim sPath       As String
    Dim sSubPath    As String
    Dim lSubCount   As Long

    Set oLeafDir = New Collection
    Set oStackDir = New Collection
    oStackDir.Add NormalizePath(Path)

    While oStackDir.Count > 0
        sPath = oStackDir(oStackDir.Count)
        oStackDir.Remove oStackDir.Count
        lSubCount = 0
        'Debug.Print sPath

        sSubPath = Dir(sPath & "*", vbDirectory)
        While LenB(sSubPath) <> 0
            If (sSubPath <> ".") And (sSubPath <> "..") Then
                If (GetAttr(sPath & sSubPath) And vbDirectory) = vbDirectory Then
                    lSubCount = lSubCount + 1
                    oStackDir.Add NormalizePath(sPath & sSubPath)
                End If
            End If

            sSubPath = Dir()
        Wend

        If lSubCount = 0 Then
            oLeafDir.Add sPath
        End If
    Wend

    Set GetLeafDirectory = oLeafDir
End Function

Public Function NormalizePath(ByVal Path As String) As String
    If Right$(Path, 1) <> "\" Then
        NormalizePath = Path & "\"
    Else
        NormalizePath = Path
    End If
End Function

[lpide619689]

引用 2 楼 Chen8013 的回复:

你这个说的有点模糊啊，看样子，是有可能要返回很多个文件夹路径？ 还有，并列的、但“层次深度”不相同的，算不算需要返回的呢？ 就拿你在主贴中的“C:\01”的例子来说：

C:\01
C:\01\a
C:\01\a\1
C:\01\a\2
C:\01\a\3
C:\01\b
C:\01\c

这种情况下，是只返回3、4、5这三项，还是3到7这５项？ 毕竟，从6、7这两条路径来说，它也算各自的“最底层”。 另外一种再复杂点的情况：

C:\01
C:\01\a
C:\01\a\1
C:\01\a\2
C:\01\a\3\x\y
C:\01\b
C:\01\c\w

这时返回的是3到7？　还是5和7？　或者只能是5？ 所以，从你的含糊的问题描述，根本就搞不清楚你要的是什么结果。

多谢！ 第一个需要的是3 4 5. 第二个需要的是5到7. 总之如果还存在有下级层子文件夹的就不要。 非常感谢！

[lpide619689]

引用 2 楼 Chen8013 的回复:

你这个说的有点模糊啊，看样子，是有可能要返回很多个文件夹路径？ 还有，并列的、但“层次深度”不相同的，算不算需要返回的呢？ 就拿你在主贴中的“C:\01”的例子来说：

C:\01
C:\01\a
C:\01\a\1
C:\01\a\2
C:\01\a\3
C:\01\b
C:\01\c

这种情况下，是只返回3、4、5这三项，还是3到7这５项？ 毕竟，从6、7这两条路径来说，它也算各自的“最底层”。 另外一种再复杂点的情况：

C:\01
C:\01\a
C:\01\a\1
C:\01\a\2
C:\01\a\3\x\y
C:\01\b
C:\01\c\w

这时返回的是3到7？　还是5和7？　或者只能是5？ 所以，从你的含糊的问题描述，根本就搞不清楚你要的是什么结果。

晕。非常抱歉楼上说错了。 应该是两个都需要的是3到7 。总之如果还存在有下级层子文件夹的就不要。

[舉杯邀明月]

' 应用示例：
Private Sub Command1_Click()
   Dim aBuff() As String
   Dim i As Long
   
   aBuff = EnmuFolders("E:\WPS Office")
         ' 参数： 要枚举“最底层子文件夹”的路径。
         '     不能从“驱动器”开始（比如 C:\ 或 C:）
         '     路径最后不要带 \ 字符
   For i = 0& To UBound(aBuff)
      Debug.Print aBuff(i)
   Next
End Sub

' 标准模块的代码：
Option Explicit

Public Function EnmuFolders(ByVal TopPath As String) As String()
   Dim arrBuff()  As String
   Dim arrTemp()  As String
   Dim strPath As String
   Dim lUSize  As Long
   Dim lUseNum As Long
   Dim lCurPnt As Long
   Dim lpValid As Long
   Dim i&, n&

   lpValid = -1
   lUSize = 31
   lCurPnt = 0
   lUseNum = 0
   ReDim arrBuff(lUSize)
   arrBuff(lUseNum) = TopPath
   Do
      strPath = arrBuff(lCurPnt)
      n = EnmuSubFolders(strPath, arrTemp)
      If (n = 0) Then
         lpValid = lpValid + 1
         arrBuff(lpValid) = strPath
      Else
         i = lUseNum + n
         strPath = strPath & "\"
         If (i > lUSize) Then
            lUSize = 7 Or (lUSize + n)
            ReDim Preserve arrBuff(lUSize)
         End If
         For i = 1 To n
            lUseNum = lUseNum + 1
            arrBuff(lUseNum) = strPath & arrTemp(i)
         Next
      End If
      lCurPnt = lCurPnt + 1
      If (lCurPnt > lUseNum) Then Exit Do
   Loop
   ReDim Preserve arrBuff(lpValid)
   EnmuFolders = arrBuff
End Function

Private Function EnmuSubFolders(ByVal FullPath As String, OutBuff() As String) As Long
   Dim t$, c&, p&

   c = -1:  p = -1
   FullPath = FullPath & "\"
   t = Dir$(FullPath & "*.*", 23)
   Do
      t = Dir$()
      If (t = "") Then Exit Do
      If (vbDirectory And GetAttr(FullPath & t)) Then
         p = p + 1
         If (p > c) Then c = c + 4: ReDim Preserve OutBuff(c)
         OutBuff(p) = t
      End If
   Loop
   EnmuSubFolders = p
End Function