❶ 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