当前位置:首页 > WPS表格 > 正文内容

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

达叔3个月前 (05-10)WPS表格84
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达师发布,如需转载请注明出处。
标签: dir遍历树状