[已解决]获取文件夹列表问题

qopani

一个文件夹内有好几个文件夹，我想用vba工作表的A列中生成该文件夹内的文件夹列表，请高手帮忙！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-2-26 17:43

1. Option Explicit
   
2. 
   
3. Sub ListDirs(ByVal Path As String, Optional iRow As Long = 1)
   
4. 
   
5.     Dim filename$
   
6.     Dim DirList()
   
7.     Dim i&
   
8. 
   
9.     ReDim DirList(1 To 1)
   
10. 
    
11.     filename = Dir(Path & "*.*", vbDirectory + vbNormal)
    
12.     Do While Len(filename)
    
13.         '判断是否为.或..
    
14.         If Not (filename = "." Or filename = "..") Then
    
15.             '判断是否为文件夹
    
16.             If (GetAttr(Path & "" & filename) And vbDirectory) = 16 Then
    
17.                 '避免读取错误
    
18.                 If Err.Number <> 0 Then Err.Clear: GoTo end1if
    
19.                 i = i + 1
    
20.                 '数据扩容
    
21.                 ReDim Preserve DirList(1 To i)
    
22.                 '存入子文件夹名
    
23.                 DirList(i) = filename
    
24.             End If
    
25.         End If
    
26. end1if:
    
27.         '继续查找
    
28.         filename = Dir
    
29.     Loop
    
30.     '判断是否有子文件夹及输出到A列指定行
    
31.     If i > 0 Then Range("a" & iRow).Resize(i) = Application.Transpose(DirList)
    
32. End Sub
    
33. 
    
34. Sub test()
    
35.     '调用过程，参数为要查找的文件夹和要输出的行位置
    
36.     Call ListDirs("c:", 10)
    
37. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

文件夹内的子文件夹要显示不？

hwc2ycy

1. Sub ListDirs(ByVal Path As String)
   
2.     Dim filename$
   
3.     Dim DirList()
   
4.     Dim i&
   
5.    
   
6.     ReDim DirList(1 To 1)
   
7.     i = 0
   
8. 
   
9.         filename = Dir(Path & "*.*", vbDirectory + vbNormal)
   
10.         Do While Len(filename)
    
11. 
    
12.             If Not (filename = "." Or filename = "..") Then
    
13.                 If (GetAttr(Path & "" & filename) And vbDirectory) = 16 Then
    
14.                     '避免读取错误
    
15.                     If Err.Number <> 0 Then Err.Clear: GoTo end1if
    
16.                     i = i + 1
    
17.                     ReDim Preserve DirList(1 To i)
    
18.                     DirList(i) = filename
    
19.                 End If
    
20.             End If
    
21. end1if:            filename = Dir
    
22.         Loop
    
23.         If i > 0 Then Range("a1").Resize(i) = Application.Transpose(DirList)
    
24. End Sub
    
25. 
    
26. Sub test()
    
27.     Call ListDirs("c:")
    
28. End Sub

复制代码

hwc2ycy

1. Option Explicit
   
2. 
   
3. Sub ListDirs(ByVal Path As String, Optional iRow As Long = 1)
   
4. 
   
5.     Dim filename$
   
6.     Dim DirList()
   
7.     Dim i&
   
8. 
   
9.     ReDim DirList(1 To 1)
   
10. 
    
11.     filename = Dir(Path & "*.*", vbDirectory + vbNormal)
    
12.     Do While Len(filename)
    
13.         '判断是否为.或..
    
14.         If Not (filename = "." Or filename = "..") Then
    
15.             '判断是否为文件夹
    
16.             If (GetAttr(Path & "" & filename) And vbDirectory) = 16 Then
    
17.                 '避免读取错误
    
18.                 If Err.Number <> 0 Then Err.Clear: GoTo end1if
    
19.                 i = i + 1
    
20.                 '数据扩容
    
21.                 ReDim Preserve DirList(1 To i)
    
22.                 '存入子文件夹名
    
23.                 DirList(i) = filename
    
24.             End If
    
25.         End If
    
26. end1if:
    
27.         '继续查找
    
28.         filename = Dir
    
29.     Loop
    
30.     '判断是否有子文件夹及输出到A列指定行
    
31.     If i > 0 Then Range("a" & iRow).Resize(i) = Application.Transpose(DirList)
    
32. End Sub
    
33. 
    
34. Sub test()
    
35.     '调用过程，参数为要查找的文件夹和要输出的行位置
    
36.     Call ListDirs("c:", 10)
    
37. End Sub

复制代码