[已解决]请老师修改已写好的程序，谢谢蓝桥老师！

lhj323323

老师：

上传的附件，内附写好的程序，可用于提取任意路径的所有文件，但存在问题，想请老师帮忙修改，先谢谢了。
新建.rar (99.57 KB, 下载次数: 18)

2016-10-14 14:26 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

蓝桥玄霜

2016-10-16 10:44

1. Sub test() '提取指定文件夹内的所有文件名
   
2.            '含所有子文件夹内的文件
   
3.     Dim Fso As Object, arrf$(), mf&
   
4.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
5.     Call GetFiles(CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path, Fso, arrf, mf)
   
6.     Sheet2.[b2].Resize(mf) = Application.Transpose(arrf)
   
7.     Set Fso = Nothing
   
8. End Sub
   
9. Private Sub GetFiles(ByVal sPath$, ByRef Fso As Object, ByRef arrf$(), ByRef mf&)
   
10.     Dim Folder As Object
    
11.     Dim SubFolder As Object
    
12.     Dim File As Object
    
13.     Set Folder = Fso.GetFolder(sPath)
    
14.    
    
15.     For Each File In Folder.Files
    
16.         mf = mf + 1
    
17.         ReDim Preserve arrf(1 To mf)
    
18.         arrf(mf) = File.Path '& File.Name
    
19.     Next
    
20.     For Each SubFolder In Folder.SubFolders
    
21.         Call GetFiles(SubFolder.Path, Fso, arrf, mf)
    
22.     Next
    
23.     Set Folder = Nothing
    
24.     Set File = Nothing
    
25. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

请看附件。

laoau138

grf1973 发表于 2016-10-14 16:34
请看附件。

用VBA计算D列连续属性总次数

http://www.excelpx.com/thread-425069-1-1.html

蓝桥玄霜

1. Sub test() '提取指定文件夹内的所有文件名
   
2.            '含所有子文件夹内的文件
   
3.     Dim Fso As Object, arrf$(), mf&
   
4.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
5.     Call GetFiles(CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path, Fso, arrf, mf)
   
6.     Sheet2.[b2].Resize(mf) = Application.Transpose(arrf)
   
7.     Set Fso = Nothing
   
8. End Sub
   
9. Private Sub GetFiles(ByVal sPath$, ByRef Fso As Object, ByRef arrf$(), ByRef mf&)
   
10.     Dim Folder As Object
    
11.     Dim SubFolder As Object
    
12.     Dim File As Object
    
13.     Set Folder = Fso.GetFolder(sPath)
    
14.    
    
15.     For Each File In Folder.Files
    
16.         mf = mf + 1
    
17.         ReDim Preserve arrf(1 To mf)
    
18.         arrf(mf) = File.Path '& File.Name
    
19.     Next
    
20.     For Each SubFolder In Folder.SubFolders
    
21.         Call GetFiles(SubFolder.Path, Fso, arrf, mf)
    
22.     Next
    
23.     Set Folder = Nothing
    
24.     Set File = Nothing
    
25. End Sub
    

复制代码

lhj323323

蓝桥玄霜 发表于 2016-10-16 10:44

谢谢蓝桥老师的帮助！