如何判断有几级子目录。

ning84

现在采用的方法SubFolders-----------Count
遍历子目录。需要人为定义几级子目录。

1. Sub TraverseFolderToSheet()
   
2.     Dim Fso As New FileSystemObject
   
3.     Dim oFolder As Folder
   
4.     Dim Arr, Arr1, Arr2
   
5.         Set Fso = New FileSystemObject
   
6.    
   
7.         Arr = TraverseFolderArr(Fso.GetFolder(ThisWorkbook.Path))
   
8.         For ii = 0 To UBound(Arr)
   
9.             Set oFolder = Arr(ii)
   
10.             Debug.Print oFolder.Name
    
11.         Next ii
    
12.         Stop
    
13.         
    
14. End Sub
    
15. 
    
16. 
    
17. 
    
18. Function TraverseFolderArr(mFolder As Folder)
    
19.     Dim oFolder As Folder, oFolders As Folders
    
20.         Set oFolders = mFolder.SubFolders
    
21.     Dim Arr() As Folder
    
22.         ReDim Arr(oFolders.Count - 1) As Folder
    
23.     Dim ii As Integer
    
24.         For Each oFolder In oFolders
    
25.               Set Arr(ii) = oFolder
    
26.               ii = ii + 1
    
27.         Next oFolder
    
28.         TraverseFolderArr = Arr
    
29. End Function
    
30. 
    
31. 
    
32. Function TraverseFolderDict(mFolder As Folder, Dict As Dictionary)
    
33.     Dim oFolder As Folder, oFolders As Folders
    
34.         Set oFolders = mFolder.SubFolders
    
35.    
    
36.         For Each oFolder In oFolders
    
37.               
    
38.               Dict(oFolder.Path) = ""
    
39.               Set Dict = TraverseFolderDict(oFolder, Dict)
    
40.         Next oFolder
    
41.         Set TraverseFolderDict = Dict
    
42.         'Stop
    
43.         
    
44. End Function
    
45. 
    
46. Sub DictTraverseFolder()
    
47.     Dim Sht As Worksheet
    
48.         Set Sht = Sheet1
    
49.         With Sht.Cells
    
50.             .Clear
    
51.             .Font.Size = 9
    
52.         End With
    
53.     Dim Fso As New FileSystemObject
    
54.     Dim oFolder As Folder
    
55.     Dim Arr, Arr1, Arr2
    
56.     Dim Dict As Dictionary
    
57.     Dim Rr As Integer
    
58.         Rr = 10
    
59.    
    
60.         Set Dict = New Dictionary
    
61.         Set Fso = New FileSystemObject
    
62.    
    
63.         Set Dict = TraverseFolderDict(Fso.GetFolder(ThisWorkbook.Path), Dict)
    
64.         ''
    
65.         For ii = 0 To Dict.Count - 1
    
66.              Debug.Print ii, Dict.Keys(ii)
    
67.              With Sht
    
68.                    .Cells(Rr + ii, 1) = ii
    
69.                    .Cells(Rr + ii, 2) = Dict.Keys(ii)
    
70.                    Set oFolder = Fso.GetFolder(.Cells(Rr + ii, 2))
    
71.                    .Cells(Rr, 3) = oFolder.SubFolders.Count
    
72.              End With
    
73.             
    
74.         Next ii
    
75.         
    
76. End Sub
    
77. 
    

复制代码

ykcbf1100

可以递归遍历啊，不用人为定义几级子目录