菜鳥
某檔案夾下面有很多子檔案夾，然后子檔案夾下面又包含很多子檔案夾......而且這樣多次....
比如c:/01/ 下面又 a b c 子檔案夾。 然后a 下面又有1 2 3 子檔案夾。。。
現在我只想要遍歷獲取到所有最底層子檔案夾（且只要最底層，其它的全部不要，子檔案夾路徑，檔案名也也不要。），含完整路徑。
最好是用 Dir 速度快是不？
非常感謝！
uj5u.com熱心網友回復：
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
uj5u.com熱心網友回復：
你這個說的有點模糊啊，看樣子，是有可能要回傳很多個檔案夾路徑？還有，并列的、但“層次深度”不相同的，算不算需要回傳的呢？
就拿你在主貼中的“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？
所以，從你的含糊的問題描述，根本就搞不清楚你要的是什么結果。
uj5u.com熱心網友回復：
多謝！ 第一個需要的是3 4 5. 第二個需要的是5到7. 總之如果還存在有下級層子檔案夾的就不要。 非常感謝！
uj5u.com熱心網友回復：
暈。非常抱歉樓上說錯了。 應該是兩個都需要的是3到7 。總之如果還存在有下級層子檔案夾的就不要。
uj5u.com熱心網友回復：
' 應用示例：
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/91030.html
標籤：VB基礎類
上一篇：求教，這個怎么做