vba遍历文件夹及子文件夹

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

F是一个临时逻辑变量，保存本程序工作簿中是否已有名为“XLS文件清单”的工作表，方便后续的代码处理，如果没有，就先建这个工作表，后面才能放置遍历出来的文件夹。
经过对代码的分析，以下两行完全可以省略
Else
F = False

B. 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

C. 如何用vba遍历文件夹里面的子文件并且复制指定数据形成一张新的表格，ps：子文件的数据格式一直

尝试用下边代码试试：

Sub OpenAndClose()

Dim MyFile As String

Dim s As String

Dim count As Integer

MyFile = Dir(文件夹目录 & "*.xlsx")

'读入文件夹中的第一个.xlsx文件

count = count + 1 '记录文件的个数

s = s & count & "、" & MyFile

Do While MyFile <> ""

MyFile = Dir '第二次读入的时候不用写参数

If MyFile = "" Then

Exit Do '当MyFile为空的时候就说明已经遍历完了，这时退出Do，否则还要运行一遍

End If

count = count + 1

If count Mod 2 <> 1 Then

s = s & vbTab & count & "、" & MyFile

Else

s = s & vbCrLf & count & "、" & MyFile

End If

Loop

Debug.Print s

End Sub

另外，可以考虑用python试试

D. VBA中怎么遍历所选路径中所有文件夹及其子文件夹(多个子文件)，并返回所有的最底层的文件夹路径

答：执行"获取所有文件夹"，按提示操作。文件夹清单会显示在工作表的AB列中。

Sub获取所有文件夹()
DimDirectoryAsString
WithApplication.FileDialog(msoFileDialogFolderPicker)
.InitialFileName=Application.DefaultFilePath&""
.Title="请选择一个文件夹"
.Show
If.SelectedItems.Count=0Then
ExitSub
Else
Directory=.SelectedItems(1)
EndIf
EndWith
Cells.ClearContents
CallRecursiveDir(Directory)
EndSub
PublicSubRecursiveDir(ByValCurrDirAsString)
DimDirs()AsString
DimNumDirsAsLong
DimFilesizeAsDouble
DimTotalFolders,SingleFolder
Cells(1,1)="目录名"
Cells(1,2)="日期/时间"
Range("A1:B1").Font.Bold=True

SetTotalFolders=CreateObject("Scripting.FileSystemObject").GetFolder(CurrDir).SubFolders
Cells(WorksheetFunction.CountA(Range("A:A"))+1,1)=CurrDir
Cells(WorksheetFunction.CountA(Range("B:B"))+1,2)=FileDateTime(CurrDir)
IfTotalFolders.Count<>0Then

ReDimPreserveDirs(0ToNumDirs)AsString
Dirs(NumDirs)=SingleFolder
NumDirs=NumDirs+1
Next
EndIf
Fori=0ToNumDirs-1
RecursiveDirDirs(i)
Nexti
EndSub

E. EXCEL VBA 遍历所有文件夹和子文件夹的文件中指定单元格中的数据，汇总到一张工作表中，

把需要遍历的所有路径，写到一个excel表里不就行了，每次从这个表里调用路径去遍历。或者dir /b /s *.xls*>d:\1.txt，把这个1.txt内容读入表或数组，遍历这个就行了。

F. 如何使用VBA遍历文件夹及其子文件夹中的所有excel，并打开后进行修改

‍

ImportsSystem.Net.Dns
ImportsSystem.Net
ImportsSystem.Net.IPAddress
PublicClassForm1
DoWhileDateFile<>""
'filname(nn)=DateFile
'DateFile=Dir
'nn=nn+1
Loop
Whileee=1
EndWhile

EndSub

EndClass

G. VBA中历遍文件夹中的图片为什么第二个就失效了myfile成了空值！哪里出了问题

看到有网友问如何 VBA中遍历 文件夹下（含有子文件夹） 的所有文件，就做了一个示例教程。
VBA中遍历文件夹下所有文件（含子文件夹）的方法
1）使用Dir() 的方法
2）使用VBA的filesercth对象
3）使用FileSystemObject对象及递归
各种方法存在的问题及对比
1）Dir()的方法遍历子文件夹文件不太方便
2）FileSearch方法在office 2007中微软把Application对象FileSearch方法删除了
3）所有比较安全的方法是使用 FileSystemObject对象实现遍历文件夹及子文件夹中所有文件
主要设计思路及程序要点
1）为避免显式引用FileSystemObject，我们使用Set fso = CreateObject("Scripting.FileSystemObject")创建对象
2）为了让程序更高效，我们使用了递归，在获取子文件夹文件时调用了函数自身
完整的实现代码如下(tmtony)
Dim lngSeqNo As Long '用来统计获取到的文件的个数，以便定义单元格行号
' 表格上单击的测试按钮代码 作者：tmtony
Sub 矩形圆角1_Click()
测试程序
End Sub
’自定义过程
Public Sub 测试程序()
Dim strPath As String
Dim fso As Object, objFolder As Object
Set fso = CreateObject("Scripting.FileSystemObject")
lngSeqNo = 0
strPath = "E:\NewTools\TreesizePro\TreeSize_7.1.3_Portable" '可改成你自己的指定目录
Set objFolder = fso.GetFolder(strPath)
GetAllFiles objFolder
' ReDim Preserve arrFiles(1 To lngFileCnt)
' For i = 1 To lngFileCnt
' Debug.Print arrFiles(i)
' Next i
End Sub
'自定义的获取子文件夹所有文件的过程，递归调用
Sub GetAllFiles(ByVal objFolder As Object)
Dim objFile As Object ' File
Dim objSubFolder As Object ' Folder
Dim arrFiles()
Dim lngFileCnt As Long
Dim i As Long
ReDim arrFiles(1 To 1000)
lngFileCnt = 0
For Each objFile In objFolder.Files
lngFileCnt = lngFileCnt + 1
If lngFileCnt > UBound(arrFiles) Then ReDim Preserve arrFiles(1 To lngFileCnt + 1000)
lngSeqNo = lngSeqNo + 1
' arrFiles(lngFileCnt) = objFile.Path
ActiveSheet.Cells(lngSeqNo, 1).Value = objFile.Path
Next objFile
If objFolder.SubFolders.Count = 0 Then Exit Sub
For Each objSubFolder In objFolder.SubFolders
GetAllFiles objSubFolder
Next
End Sub
执行后的结果写到Excel单元格中，效果如下
原创不易，如果您觉得这个示例能帮到您。请给我们点个赞及关注一下我们。谢谢

H. 如何用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

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

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