求VBA遍历子文件夹代码

liufb203 · 发表于 2014-4-23 17:32

我有一个文件夹，该文件夹内有三个子文件夹，每个子文件夹下又有若干个子子文件夹，而且会根据工作进度不断增加。我想在文件夹下放置一个Excel文件，运行宏时自动列出各子文件夹及子文件夹下的子子文件夹。求高手给个代码！（注：我原有的文件夹不在根目录下。）

1583478094 · 发表于 2014-4-23 18:43

cbtaja 发表于 2014-4-23 18:16
使用命令行tree命令，方法如下，供参考：

假如要遍历显示D:\的子目录，可在“开始”——“运行”中输入并 ...

你这个不好处理，我认为用 dir 好

xmtutoo · 发表于 2014-4-23 17:51

以前有在这里下载过《制作链接文件目录.xls》，这东东适合你的需求。

cbtaja · 发表于 2014-4-23 18:16

使用命令行tree命令，方法如下，供参考：

假如要遍历显示D:\的子目录，可在“开始”——“运行”中输入并回车：

tree d:\ > c:\aaaa.txt

复制代码

则结果在C:\aaaa.txt中列出了所有子目录

1583478094 · 发表于 2014-4-23 18:47

xmtutoo 发表于 2014-4-23 17:51
以前有在这里下载过《制作链接文件目录.xls》，这东东适合你的需求。

非常给力，谢谢分享！！！！！！

wudixin96 · 发表于 2014-4-23 18:54

自己百度一下，FSO SUBFOLDERS 递归

liufb203 · 发表于 2014-4-24 09:00

是不是我没表达清楚啊？我只想知道子文件夹的名字以及子文件夹包含的文件夹名字，至于里面有什么文件我不需要知道的

百度不到去谷歌 · 发表于 2014-4-24 09:04

遍历文件夹百度一把一把的啊
随便给你一个
核心函数如下

'-----------Sub GetFiles----------Copyright@百度不到去谷歌 QQ80871835 2014/3/10---------------------------
'功能 :'遍历path目录,返回所有文件名数组,fullname参数可选是否返回完整路径
'变量 :path string -文件夹路径
' Fullname Boolean -是否返回完整路径,默认为true返回完整
'--------------------------------------------------------------------------------------------------
Function GetFiles(path$, Optional Fullname As Boolean = True)
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Dim Fso As Object, Folder As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Folder = Fso.GetFolder(path)
i = 1
Call aGetFile(Folder, dic)
If Fullname Then
GetFiles = dic.keys '返回文件名
Else
GetFiles = dic.items '返回完整路径带文件名
End If
Set Folder = Nothing
Set Fso = Nothing
MsgBox "ok"
End Function
Sub aGetFile(ByVal Folder As Object, dic)
Dim SubFolder As Object
Dim File As Object
For Each File In Folder.Files '遍历文件
dic.Add File.path & "" & Filename, File.Name
Next
For Each SubFolder In Folder.SubFolders
Call aGetFile(SubFolder, dic) '递归调用子文件夹
Next
End Sub

复制代码

示范文件

VBA-返回文件夹及子文件夹文件数组--通用函数.rar (36.97 KB, 下载次数: 203)

liufb203 · 发表于 2014-4-24 09:22

楼上给你的太高端了，初学者玩不转啊！
帮我看看我变的这个：
Sub wenjiajia()
Dim s As String
Dim dangqian As String
Dim n As Integer
dangqian = Dir(ThisWorkbook.Path, 16)
Do Until dangqian = ""
If dangqian Like "*.*" Then
Else
s = s & Chr(13) & dangqian
End If
dangqian = Dir
Loop
MsgBox s
End Sub
我把这个放到E盘根目录下时能统计E盘根目录下的文件夹名称，但是我把它复制到E盘下的一个文件夹中时，它就不能返回这个文件夹中的子文件夹了。问题出在哪？

百度不到去谷歌 · 发表于 2014-4-24 09:40

本帖最后由百度不到去谷歌于 2014-4-25 09:54 编辑

你这个不行的我的改一下就可以了
你只需要复制我的代码然后调用的地方
dim arr
arr=GetFiles(thisworkbook.path,0 , "fo")'arr就是所有文件夹及子文件夹的名称数组

'-----------Sub GetFiles----------Copyright@百度不到去谷歌 QQ80871835 2014/3/10---------------------------
'功能 :'遍历path目录,返回所有文件名或者文件夹名数组,fullname参数可选是否返回完整路径
'变量 :path string -文件夹路径
' Fullname Boolean -是否返回完整路径,默认为true返回完整
' ftype string -返回文件还是文件夹,f为文件,fo为文件夹
'--------------------------------------------------------------------------------------------------
Function GetFiles(path$, Optional Fullname As Boolean = True, Optional ftype = "f")
Dim dic As Object, i&
Set dic = CreateObject("Scripting.Dictionary")
Dim Fso As Object, Folder As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Folder = Fso.GetFolder(path)
i = 1
Call aGetFile(Folder, dic, ftype)
If Fullname Then
GetFiles = dic.keys '返回文件名
Else
GetFiles = dic.items '返回完整路径带文件名
End If
Set Folder = Nothing
Set Fso = Nothing
MsgBox "ok"
End Function
Sub aGetFile(ByVal Folder As Object, dic, Optional ftype = "f")
Dim SubFolder As Object
Dim File As Object
If ftype = "fo" Then
For Each SubFolder In Folder.SubFolders
dic.Add SubFolder.path, SubFolder.Name
Call aGetFile(SubFolder, dic, ftype) '递归调用子文件夹
Next
Else '遍历文件
For Each File In Folder.Files '遍历文件
dic.Add File.path & "" & File.Name, File.Name
Next
For Each SubFolder In Folder.SubFolders
Call aGetFile(SubFolder, dic, ftype) '递归调用子文件夹
Next
End If
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 求VBA遍历子文件夹代码

点评

最新热点 /1