篇首语：本文由小编为大家整理，主要介绍了VBA中怎么遍历所选路径中所有文件夹及其子文件夹(多个子文件)，并返回所有的最底层的文件夹路径相关的知识，希望对你有一定的参考价值。
选择一个路径后，返回所有文件夹中的子文件夹及其子文件夹，也就是每个最下层的文件夹路径。文件夹层数没规律，新手，求解，谢谢各位了
答：执行"获取所有文件夹"，按提示操作。文件夹清单会显示在工作表的AB列中。
Sub 获取所有文件夹()Dim Directory As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "请选择一个文件夹"
.Show
If .SelectedItems.Count = 0 Then
Exit Sub
Else
Directory = .SelectedItems(1)
End If
End With
Cells.ClearContents
Call RecursiveDir(Directory)
End Sub
Public Sub RecursiveDir(ByVal CurrDir As String)
Dim Dirs() As String
Dim NumDirs As Long
Dim Filesize As Double
Dim TotalFolders, SingleFolder
Cells(1, 1) = "目录名"
Cells(1, 2) = "日期/时间"
Range("A1:B1").Font.Bold = True
Set TotalFolders = CreateObject("Scripting.FileSystemObject").GetFolder(CurrDir).SubFolders
Cells(WorksheetFunction.CountA(Range("A:A")) + 1, 1) = CurrDir
Cells(WorksheetFunction.CountA(Range("B:B")) + 1, 2) = FileDateTime(CurrDir)
If TotalFolders.Count <> 0 Then
For Each SingleFolder In TotalFolders
ReDim Preserve Dirs(0 To NumDirs) As String
Dirs(NumDirs) = SingleFolder
NumDirs = NumDirs + 1
Next
End If
For i = 0 To NumDirs - 1
RecursiveDir Dirs(i)
Next i
End Sub 参考技术A Sub Test()
Dim MyName, Dic, Did, I, T, F, TT, MyFileName
T = Time
Set Dic = CreateObject("Scripting.Dictionary") "创建一个字典对象
Set Did = CreateObject("Scripting.Dictionary")
Dic.Add ("C:\Users\Administrator\Desktop\VB.NET\"), ""
I = 0
Do While I < Dic.Count
Ke = Dic.keys "开始遍历字典
MyName = Dir(Ke(I), vbDirectory) "查找目录
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If (GetAttr(Ke(I) & MyName) And vbDirectory) = vbDirectory Then "如果是次级目录
Dic.Add (Ke(I) & MyName & "\"), "" "就往字典中添加这个次级目录名作为一个条目
End If
End If
MyName = Dir "继续遍历寻找
Loop
I = I + 1
Loop
Did.Add ("文件清单"), "" "以查找D盘My Documents下所有EXCEL文件为例
For Each Ke In Dic.keys
MyFileName = Dir(Ke & "*.*")
Do While MyFileName <> ""
Did.Add (Ke & MyFileName), ""
MyFileName = Dir
Loop
Next
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name = "XLS文件清单" Then
Sheets("XLS文件清单").Cells.Delete
F = True
Exit For
Else
F = False
End If
Next
If Not F Then
Sheets.Add.Name = "XLS文件清单"
End If
Sheets("XLS文件清单").[A1].Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.keys)
TT = Time - T
MsgBox Minute(TT) & "分" & Second(TT) & "秒"
End Sub
VBA获取某文件夹下所有文件和子文件目录的文件
参考技术A 【引用位置】 https://blog.csdn.net/pashine/article/details/42100237"-------------------------------------------
"获取某文件夹下的所有Excel文件
"-------------------------------------------
Sub getExcelFile(sFolderPath As String)
On Error Resume Next
Dim f As String
Dim file() As String
Dim x
k = 1
ReDim file(1)
file(1) = sFolderPath & ""
End Sub
"-------------------------------------------
"获取某文件夹下的所有文件和子目录下的文件
"-------------------------------------------
Sub getAllFile(sFolderPath As String)
"Columns(1).Delete
On Error Resume Next
Dim f As String
Dim file() As String
Dim i, k, x
x = 1
i = 1
k = 1
ReDim file(1 To i)
file(1) = sFolderPath & ""
"-- 获得所有子目录
Do Until i > k
f = Dir(file(i), vbDirectory)
Do Until f = ""
If InStr(f, ".") = 0 Then
k = k + 1
ReDim Preserve file(1 To k)
file(k) = file(i) & f & ""
End If
f = Dir
Loop
i = i + 1
Loop
"-- 获得所有子目录下的所有文件
For i = 1 To k
f = Dir(file(i) & " . ") "通配符 . 表示所有文件，*.xlsx Excel文件
Do Until f = ""
"Range("a" & x) = f
Range("a" & x).Hyperlinks.Add Anchor:=Range("a" & x), Address:=file(i) & f, TextToDisplay:=f
x = x + 1
f = Dir
Loop
Next
End Sub
以上是关于VBA中怎么遍历所选路径中所有文件夹及其子文件夹(多个子文件)，并返回所有的最底层的文件夹路径的主要内容，如果未能解决你的问题，请参考以下文章
