❶ 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 = NothingEnd 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.FilesDebug.PrintF.Name'这里放你的宏，f.name就是依次的文件名NextEndSubSub同文件夹下所有文件汇总()DimwjjAsStringDimDirNameAsStringDimname1AsStringIfActiveWorkbook.Path="X:excel"ThenExitSub'自我保护。Application.ScreenUpdating=FalseForj=1To3'根据表数Worksheets(j).Cells.ClearNextjwjj=ActiveWorkbook.Pathname1=ActiveWorkbook.NameDirName=Dir(wjj&"*.xls")DoWhileDirName<>""IfDirName<>name1ThenWorkbooks.OpenFilename:=wjj&""&DirNameWorkbooks(name1).ActivateFori=1To3'根据表数Sheets(i).Range("a65536").End(xlUp).Offset(1,0).Offset(0,1)=DirNameWorkbooks(DirName).Sheets(i).Range("A4:J2000").Copy_Sheets(i).Range("a65536").End(xlUp).Offset(2,0)NextWorkbooks(DirName).CloseFalseEndIfDirName=DirLoopApplication.ScreenUpdating=TrueEndSub
仅供参考。
❺ EXCEL VBA 获取文件夹及子文件夹下所有文件并建立超链接
可以用代码完成：1、先编制表格：2、在表格里编写触发宏代码：privatesubworksheet_change(byvaltargetasrange)dimphotonameasstringiftarget.row=3andtarget.column>3andtarget.column<6thenonerrorresumenext'忽略错误继续执行vba代码,避免出现错误消息application.screenupdating=falseapplication.enableevents=falseforeachshpinsheets("查询表").shapesifshp.type<>8andshp.type<>12thenshp.deleteendifnextphotoname=cells(3,4)&".jpg"cells(3,"l").selectactivesheet.pictures.insert(activeworkbook.path&"\照片\"&photoname).select'当前文件所在目录下以单元内容为名称的.jpg图片withselectionta=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'按比例调整图片高度endwithcells(3,4).selectapplication.enableevents=trueapplication.screenupdating=trueendsub3、在当前目录下建个名为”照片“的子目录，里面存有以姓名为名称的.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).rowWorkbooks.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,MyFileNameT=TimeSetDic=CreateObject("Scripting.Dictionary")'创建一个字典对象SetDid=CreateObject("Scripting.Dictionary")Dic.Add("D:MyDocuments"),""I=0DoWhileI<Dic.CountKe=Dic.keys'开始遍历字典MyName=Dir(Ke(I),vbDirectory)'查找目录DoWhileMyName<>""IfMyName<>"."AndMyName<>".."ThenIf(GetAttr(Ke(I)&MyName)AndvbDirectory)=vbDirectoryThen'如果是次级目录Dic.Add(Ke(I)&MyName&""),""'就往字典中添加这个次级目录名作为一个条目EndIfEndIfMyName=Dir'继续遍历寻找LoopI=I+1LoopDid.Add("文件清单"),""'以查找D盘MyDocuments下所有EXCEL文件为例ForEachKeInDic.keysMyFileName=Dir(Ke&"*.xls")DoWhileMyFileName<>""Did.Add(Ke&MyFileName),""MyFileName=DirLoopNextForEachShInThisWorkbook.WorksheetsIfSh.Name="XLS文件清单"ThenSheets("XLS文件清单").Cells.DeleteF=TrueExitForElseF=FalseEndIfNextIfNotFThenSheets.Add.Name="XLS文件清单"EndIfSheets("XLS文件清单").[A1].Resize(Did.Count,1)=WorksheetFunction.Transpose(Did.keys)TT=Time-TMsgBoxMinute(TT)&"分"&Second(TT)&"秒"EndSub
