VBA DIR遍历文件夹子目录,树状结构

2020-05-10 22:59:00  阅读 466 次 评论 0 条
Sub 文件树()
Dim MyName, Dic, i, t, m, TT, MyFileName, dKeys
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)
If Not objFolder Is Nothing Then lj = objFolder.self.Path & "\"
Set objFolder = Nothing
Set objShell = Nothing
t = Time
Set Dic = CreateObject("Scripting.Dictionary")
Dic.Add (lj), ""
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
Sheet1.Cells.Clear
Sheet1.[A1].Resize(Dic.Count, 1) = WorksheetFunction.Transpose(Dic.keys)
Sheet1.[A1].Sort Key1:=Sheet1.Columns("A")
dKeys = Sheet1.[A1].Resize(Dic.Count, 1).Value
Sheet1.Cells.Clear
Set Dic = Nothing
i = 1
For Each ke In dKeys
n = UBound(Split(ke, "\"))
Sheet1.Cells(i, n) = ke
m = 1
MyFileName = Dir(ke & "*.*")
Do While MyFileName <> ""
MyFileName = Dir
Sheet1.Cells(i, n).Offset(m, 1) = MyFileName
m = m + 1
Loop
i = i + m
Next
TT = Time - t
MsgBox Minute(TT) & "分" & Second(TT) & "秒"
End Sub


WPS达师专注于免费分享WPS Office使用教程、PPT、word模板及办公常用软件等资源,欢迎大家收藏和分享本站。
WPS表格数据付费处理请加QQ:3247742

发表评论


表情

还没有留言,还不快点抢沙发?