递归文件夹目录层级vba

⑴ vba 遍历指定文件夹（含子目录）获取文件名，哪种方法速度最快

Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'这里很关键，决定宏执行快慢的关键
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'打开目录选择框
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
.Title = "请选择目录"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With

'取消选择
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings

'指定过滤的文件后缀
myExtension = "*.xls*"

'遍历全路径
myFile = Dir(myPath & myExtension)

'循环处理每一个文件
Do While myFile <> ""
'打开
Set wb = Workbooks.Open(Filename:=myPath & myFile)

'确保工作簿被打开，在处理下一个文件时
DoEvents

'设置背景色
wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)

'保存工作簿
wb.Close SaveChanges:=True

'确保工作簿被关闭，在处理下一个文件时
DoEvents

'接着处理下一个
myFile = Dir
Loop

'提示处理完成
MsgBox "处理完成!"

ResetSettings:
'恢复设置
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

⑵ VBA对文件夹和文件排序

用VBA处理
没有问题
。
但
你的问题
比较抽象，对哪一个文件夹、排序条件优先
次序
，用EXCEL中的VBA还是WORD？未明确，故编写有点！？！
因为刚看到你的提问，时间太紧，你把问题更具体一点，告诉邮箱地址，我把答案发给你。
补充：
附件的宏已经能够把指定的文件夹中的（包括子文件夹）所有文件遍历，信息保存在
工作表
中，并按要求排序。
当然可以做到，不用写入
路径
，采用
鼠标
点击访问文件夹。因时间来不及，有空改写后发给你。
附件：遍历文件并排序.xls

⑶ 求助]如何用VBA遍历指定目录下的所有子文件夹和文件-字典模式

F是一个临时逻辑变量，在循环查找工作簿中是否有名为“XLS文件清单”的工作表，找到为“真”，否则为假。目的是方便后续的代码处理，如果没有这个工作表，则先创建建这个工作表，后面才能放置遍历出来的文件夹及文件名。

⑷ VBA实现递归遍历所选中的路径，并将该路径下文件及子文件夹中所有文件路径列出在第一列，求大神帮忙。

您能提出这等 问题说明您的VBA水平有一定火候了，请看
Function Fllst(Pth$)
Dim Fso As Object
Dim Fld, Fl
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fld = Fso.getfolder(Pth)
On Error Resume Next

For Each Fl In Fld.Files
[A65536].End(3)(2) = Fl.path
Next
For Each Fl In Fld.SubFolders
Fllst (Fl.path)
Next
End Function

Sub getList()
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
[A:A].ClearContents
Application.ScreenUpdating = False
Fllst (CreateObject("Shell.Application").BrowseForFolder(0, "请选择目录", 0, "").Self.path)
Application.ScreenUpdating = True
Set Fso = Nothing
End Sub

⑸ 怎么用vba遍历文件夹里的所有文件

遍历操作，一般运用于提取和写入等的操作，其基本原理和代码都一样，

遍历的方法也有很多种，以下我提供一种方法open法，除去红框以内

的代码基本都是遍历的基础代码，在这个基础上可以做根据实际需要的添加修改

⑹ 如何用VBA遍历指定目录下的所有子文件夹和文件

SubTest()
DimMyName,Dic,Did,I,T,F,TT,MyFileName
T=Time
SetDic=CreateObject("Scripting.Dictionary")'创建一个字典对象
SetDid=CreateObject("Scripting.Dictionary")
Dic.Add("D:MyDocuments"),""
I=0
DoWhileI<Dic.Count
Ke=Dic.keys'开始遍历字典
MyName=Dir(Ke(I),vbDirectory)'查找目录
DoWhileMyName<>""
IfMyName<>"."AndMyName<>".."Then
If(GetAttr(Ke(I)&MyName)AndvbDirectory)=vbDirectoryThen'如果是次级目录
Dic.Add(Ke(I)&MyName&""),""'就往字典中添加这个次级目录名作为一个条目
EndIf
EndIf
MyName=Dir'继续遍历寻找
Loop
I=I+1
Loop
Did.Add("文件清单"),""'以查找D盘MyDocuments下所有EXCEL文件为例
ForEachKeInDic.keys
MyFileName=Dir(Ke&"*.xls")
DoWhileMyFileName<>""
Did.Add(Ke&MyFileName),""
MyFileName=Dir
Loop
Next
ForEachShInThisWorkbook.Worksheets
IfSh.Name="XLS文件清单"Then
Sheets("XLS文件清单").Cells.Delete
F=True
ExitFor
Else
F=False
EndIf
Next
IfNotFThen
Sheets.Add.Name="XLS文件清单"
EndIf
Sheets("XLS文件清单").[A1].Resize(Did.Count,1)=WorksheetFunction.Transpose(Did.keys)
TT=Time-T
MsgBoxMinute(TT)&"分"&Second(TT)&"秒"
EndSub

⑺ 如何用VBA遍历指定目录下的所有子文件夹Excel文件的所有工作表

下面的代码是手工码的，不晓得有没有问题。

subtest()
dimfasstring,mPathasstring,Wbasworkbook,ShasworkSheet
ifworkbooks.count>1thenmsgbox"关闭其他工作簿！":exitsub
mPath="D:临时文件夹"'指定路径，注意分层标记
f=dir(mPath&"*.xls*")
dowhilef<>""
iff<>thisworkbook.namethen
setWb=workbooks.open(mPath&f)'只读方式打开
withWb
foreachShin.workSheets
'对工作表进行操作的代码段，自己写。
next
endwith
wb.close0'关闭文件
endif
f=dir'枚举,以访问下一个工作簿。
loop
endsub

⑻ 如何通过VBA快速寻找到文件夹及其中的子文件夹，并建立超链接。多谢！

Sub ABC()
Dim Sph
Sph = Dir("D:\data\*" & Cells(1, 1) & "*", 16)
If Sph = "" Then Exit Sub
Sph = "D:\data\" & Sph & "\"
Dir Sph, 16
Dir
Do
co = co + 1
sph1 = Dir()
If sph1 = "" Then Exit Do
Cells(2, co) = sph1
ActiveSheet.Hyperlinks.Add Cells(2, co), Sph & sph1
Loop
For i = 1 To co - 1
If Dir(Sph & Cells(2, i) & "\*") <> "" Then
ro = 3
Do
fi = Dir()
If fi = "" Then Exit Do
Cells(ro, i) = fi
ActiveSheet.Hyperlinks.Add Cells(ro, i), Sph & Cells(2, i) & "\" & fi
ro = ro + 1
Loop
End If
Next
End Sub

以上代码可满足你的要求。有问题请追问

⑼ 在excal中如何用vba实现目录树

不知道你想怎么实现？既然没有说明，那就随便做好了。
用递归循环所有目录，主目录写在A列，子目录依次写在B、C.....之内就达到你的目的了

⑽ excel用vba指定同级目录下的子目录文件

Sub aRef()
Dim i As Long
Dim fs As Object
Set fs = Application.FileSearch
With fs
'设置要查找的起始目录
.LookIn = "E:\My Documents\Downloads" ‘’查找的文件夹
'要查找的文件类型
.FileType = msoFileTypeExcelWorkbooks
'是否查找子目录
.SearchSubFolders = True
'根据上面的设置执行查找
.Execute
For i = 1 To .FoundFiles.Count
'遍历打开找到的EXCEL文件
Cells(i, 1) = .FoundFiles(i) ''excel文件的路径
'其它处理
'.....
Next i
End With
End Sub