❶ EXCEL VBA 遍历所有文件夹和子文件夹的文件中指定单元格中的数据，汇总到一张工作表中，
把需要遍历的所有路径，写到一个excel表里不就行了，每次从这个表里调用路径去遍历。或者dir /b /s *.xls*>d:\1.txt，把这个1.txt内容读入表或数组，遍历这个就行了。
❷ VBA怎么在文件夹内，提取EXCEL的特定内容
Sub readsubfolders()
i = Cells(Rows.Count, 1).End(3).Row
Set fso = CreateObject("scripting.filesystemobject")
Set myfolder = fso.GetFolder("D:\a") '引号内填写文件夹a的完整路径
For Each myfile In myfolder.Files
If myfile.Name Like "*.xls*" Then
Set wb = Workbook.Open(myfile.Path)
i = i + 1
Cells(i, 1) = wb.Name
Cells(i, 2) = wb.Worksheets("餐饮费用").[b2]
Set rg = wb.Worksheets("餐饮费用").UsedRange.Find(What:="供货商地址", LookIn:=xlValues, LookAt:=xlWhole)
Cells(i, 3) = rg.Offset(1)
Cells(i, 4) = rg.Offset(2)
Set rg = wb.Worksheets("餐饮费用").UsedRange.Find(What:="承包商地址", LookIn:=xlValues, LookAt:=xlWhole)
Cells(i, 5) = rg.Offset(1)
Cells(i, 6) = rg.Offset(2)
Set rg = wb.Worksheets("餐饮费用").UsedRange.Find(What:="进货详单内容2", LookIn:=xlValues, LookAt:=xlWhole)
Cells(i, 7) = rg.Offset(, 1)
wb.Close False
End If
Next
Set fso = Nothing
End Sub
❸ VBA获取某文件夹下所有文件和子文件目录的文件
【引用位置】 https://blog.csdn.net/pashine/article/details/42100237
'-------------------------------------------
'获取某文件夹下的所有Excel文件
'-------------------------------------------
Sub getExcelFile(sFolderPath As String)
On Error Resume Next
Dim f As String
Dim file() As String
Dim x
k = 1
ReDim file(1)
file(1) = sFolderPath & ""
End Sub
'-------------------------------------------
'获取某文件夹下的所有文件和子目录下的文件
'-------------------------------------------
Sub getAllFile(sFolderPath As String)
'Columns(1).Delete
On Error Resume Next
Dim f As String
Dim file() As String
Dim i, k, x
x = 1
i = 1
k = 1
ReDim file(1 To i)
file(1) = sFolderPath & ""
'-- 获得所有子目录
Do Until i > k
f = Dir(file(i), vbDirectory)
Do Until f = ""
If InStr(f, ".") = 0 Then
k = k + 1
ReDim Preserve file(1 To k)
file(k) = file(i) & f & ""
End If
f = Dir
Loop
i = i + 1
Loop
'-- 获得所有子目录下的所有文件
For i = 1 To k
f = Dir(file(i) & " . ") '通配符 . 表示所有文件，*.xlsx Excel文件
Do Until f = ""
'Range("a" & x) = f
Range("a" & x).Hyperlinks.Add Anchor:=Range("a" & x), Address:=file(i) & f, TextToDisplay:=f
x = x + 1
f = Dir
Loop
Next
End Sub
❹ excel怎样用VBA的方式实现文档所在文件夹下的文件内容汇总
戳我头像，一切都会有的。 所得取决于所付出的。
大家都很忙的，别说帮忙，越帮越忙。
上文件，最好上两个部门的，和结果。
Sub同文件夹下所有文件()
SetR=CreateObject("Scripting.FileSystemObject").GetFolder("X:我的照片Camera")'可以改成你的路径
ForEachFInR.Files
Debug.PrintF.Name
'这里放你的宏，f.name就是依次的文件名
Next
EndSub
Sub同文件夹下所有文件汇总()
DimwjjAsString
DimDirNameAsString
Dimname1AsString
IfActiveWorkbook.Path="X:excel"ThenExitSub'自我保护。
Application.ScreenUpdating=False
Forj=1To3'根据表数
Worksheets(j).Cells.Clear
Nextj
wjj=ActiveWorkbook.Path
name1=ActiveWorkbook.Name
DirName=Dir(wjj&"*.xls")
DoWhileDirName<>""
IfDirName<>name1Then
Workbooks.OpenFilename:=wjj&""&DirName
Workbooks(name1).Activate
Fori=1To3'根据表数
Sheets(i).Range("a65536").End(xlUp).Offset(1,0).Offset(0,1)=DirName
Workbooks(DirName).Sheets(i).Range("A4:J2000").Copy_
Sheets(i).Range("a65536").End(xlUp).Offset(2,0)
Next
Workbooks(DirName).CloseFalse
EndIf
DirName=Dir
Loop
Application.ScreenUpdating=True
EndSub
仅供参考。
❺ EXCEL VBA 获取文件夹及子文件夹下所有文件并建立超链接
可以用代码完成：
1、先编制表格：
2、在表格里编写触发宏代码：
private
sub
worksheet_change(byval
target
as
range)
dim
photoname
as
string
if
target.row
=
3
and
target.column
>
3
and
target.column
<
6
then
on
error
resume
next
'忽略错误继续执行vba代码,避免出现错误消息
application.screenupdating
=
false
application.enableevents
=
false
for
each
shp
in
sheets("查询表").shapes
if
shp.type
<>
8
and
shp.type
<>
12
then
shp.delete
end
if
next
photoname
=
cells(3,
4)
&
".jpg"
cells(3,
"l").select
activesheet.pictures.insert(activeworkbook.path
&
"\照片\"
&
photoname).select
'当前文件所在目录下以单元内容为名称的.jpg图片
with
selection
ta
=
range(cells(3,
"l").mergearea.address).height
'单元高度
tb
=
range(cells(3,
"l").mergearea.address).width
'单元宽度
tc
=
.height
'图片高度
td
=
.width
'图片宽度
tm
=
application.worksheetfunction.min(ta
/
tc,
tb
/
td)
'单元与图片之间长宽差异比例的最小值
.top
=
activecell.top
+
2
.left
=
activecell.left
+
1
.height
=
.height
*
tm
*
0.98
'按比例调整图片宽度
.width
=
.width
*
tm
*
0.98
'按比例调整图片高度
end
with
cells(3,
4).select
application.enableevents
=
true
application.screenupdating
=
true
end
sub
3、在当前目录下建个名为”照片“的子目录，里面存有以姓名为名称的.jpg格式的照片
4、在姓名后单元输入姓名后，就能自动插入图片了
❻ VBA 怎么提取二级、三级文件夹下的文件
如果只是修改你说的内容就比较简单，要提取子文件夹中的文件，用VBA也是可以的。写起来有点麻烦，还不如直接用个DOS命令先提取文件名，这样来得快：
1：运行->cmd然后会出来命令提示符,再输入dir e:\access /B/S *.xls > e:\data.xls (以上是直接把e盘access这个文件夹中的所有.xls文件和子文件夹中的.xls文件名提取出来并保存到e盘的data.xls中)(data.xls是自己生成不用新建)
2：打开data.xls文件，就会发现A列全是文件路径和名称，然后在B列把A列的文件名分离出来。
然后建一个commandbutton，输入以下代码：
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False '关闭屏幕刷新
Application.DisplayAlerts = False '禁用所有事件
for i=1 to range("a65536").end(xlup).row
Workbooks.Open range("a"&i)
For Each sht In Sheets
If sht.Name = "Sheet1" Then
sht.Range("D3") = "己复核"
End If
Next
workbooks(trim(range("b"&i))).Close True
next
Application.DisplayAlerts = True ' 启用所有事件
Application.ScreenUpdating = True '打开屏幕刷新
END SUB
❼ EXCEL VBA 如果能够快速准确的汇总文件夹（包含子文件夹）中的EXCEL文件。
可以设置公式进行汇总，只需要一条VBA命令将公式生成的实际链接转换成真正的公式就OK了，以下是我对另一提问者提出的同样问题的回答，请参考：http://..com/question/294042730.html
问题：在不打开EXCEL表的前提下，有办法将同一文件夹下的相同单元格数据进行汇总吗？
回答：
可以的。步骤如下：
1、取得该文件夹下需要汇总的Excel文档列表，把文件名称放在A列。如果文件名没什么规律并且数据很多的话可以使用Dos命令dir >list.txt，然后用Excel打开list.txt文件并复制文件名。
2、在B列中输入公式="='" & 文件夹路径 & "[" & A1 & "]" & 工作表名称 & "'!" & 单元格地址。（注上述公式中的文件夹路径、工作表名称及单元格地址请根据实际需要修改）
3、经上述两步后B列单元格内容即为目标单元格的路径，是一个字符串。复制B列内容，将其值粘贴到C列。
4、选择C列中有数据的单元格，在VB编辑器的立即窗口中输入命令：selection.formula=selection.value并回车
5、等待Excel计算完成后你就可以发现C列值已经变成各个Excel文件中对应单元格的值了。
6、对C列数据进行求和就OK了
❽ 利用VBA将文件夹中文件的内容快速汇总到一个工作簿中的代码
别用等于，用
昨天我也遇见了这个问题，后来发现，单元格区域转成数组了之后，不是二维数组，而是又嵌套了一层数组。所以两端即使一样，也会被提示类型不匹配。
所以我直接用了。等于的话设计到给单元格区域赋值。所以VB要转化成数组再复制给单元格区域。当提取的时候是嵌套数组，而写入的时候只能用一维数组写入，从而导致了错误。
所以干脆用。不用赋值，而不是通过粘贴板粘贴。这样就跟数组无关了。
❾ 如何用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试试
❿ 如何用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