vba文件夾遍歷

⑴ 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單元格中，效果如下
原創不易，如果您覺得這個示例能幫到您。請給我們點個贊及關注一下我們。謝謝

⑵ 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中怎麼遍歷所選路徑中所有文件夾及其子文件夾(多個子文件)，並返回所有的最底層的文件夾路徑

答：執行"獲取所有文件夾"，按提示操作。文件夾清單會顯示在工作表的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

⑷ VBA編程，遍歷文件夾下的excel表，對每個excel表遍歷做一些操作

（一）FileSystemObject對象模型包含了下面的對象和集合：

·FileSystemObject主對象，包含用來創建、刪除和獲得有關信息，以及用來操作驅動器、文件夾和文件的方法和屬性。

·Drive 對象，包含用來獲得信息的方法和屬性，這些信息是關於連接在系統上的驅動器的，如有多少可用空間等。驅動器不一定是硬碟，也可以是CD－ROM、U盤甚至是通過網路在邏輯上連接的硬碟（如公司里部門共享的伺服器網路硬碟）。

·Drives 集合，提供驅動器的列表，這些驅動器以實物或在邏輯上與系統相連接。Drives集合包括所有驅動器，與類型無關。

·File 對象，包含用來創建、刪除或移動文件的方法和屬性。

·Files 集合，提供包含在文件夾內的所有文件的列表。

·Folder 對象，包含用來創建、刪除或移動文件夾的方法和屬性。

·Folders 集合，提供包含在文件夾內的所有文件夾的列表。

·TextStream 對象，用來讀寫文本文件。

（二）FileSystemObject對象的方法

FileSystemObject對象模型中有些功能是重復的，如可用FileSystemObject對象的CpoyFile方法，也可用File對象的Copy方法來復制文件。下面先介紹FileSystemObject對象的方法。

1、GetDrive 方法

語法：object.GetDrive drivespec

drivespec參數可以是一個驅動器字元（c）、一個驅動器字元加一個冒號（c:）、一個驅動器字元加冒號和路徑分隔符（c:）或任何網路共享的說明（file://computer2/share1）。

作用：返回一個與指定路徑中的驅動器相對應的 Drive 對象。

示例：

Dim dSet
d = fso.GetDrive("D:") '變數d就代表了驅動器D對象

如果 drivespec 不符合任何一種可以接受的形式或者不存在，則發生一個錯誤。

注意：為簡潔，示例中都假定fso是已經創建的FileSystemObject對象

2、GetDriveName 方法

語法：object.GetDriveName(path)

作用：返回一個包含指定路徑的驅動器名字的字元串。

示例：

Debug.Print fso.GetDriveName("c: est.txt") '立即窗口顯示"c:"

3、GetExtensionName 方法

語法：object.GetExtensionName(path)

作用：返回一個包含路徑中最後部件擴展名的字元串。

示例：

Debug.Print fso.GetExtensionName("c: est.txt") '立即窗口顯示"txt"

4、GetBaseName 方法

語法：object.GetBaseName(path)

作用：返回一個包含路徑中最後部件的基本名字（去掉任何文件擴展名）的字元串。

示例：

Debug.Print fso.GetBaseName("c:abc est.txt") '立即窗口顯示"test"

5、GetAbsolutePathName 方法

語法：object.GetAbsolutePathName(pathspec)

作用：從提供的路徑說明中返回一個完整、明確的路徑。

示例：
如果pathspec為空字元串""，則返回當前路徑。假設當前路徑為C:Documents and SettingsycMy Documents

Debug.Print fs.GetAbsolutePathName("") '顯示C:Documents and SettingsycMy Documents
Debug.Print fs.GetAbsolutePathName("c:..") '顯示C:Documents and Settingsyc，即上層目錄
Debug.Print fs.GetAbsolutePathName("abc") '顯示C:Documents and SettingsycMy Documentsabc
Debug.Print fs.GetAbsolutePathName("c: est.txt") '顯示C: est.txt

6、GetFile 方法

語法：object.GetFile(filespec)

作用：返回一個和指定路徑中文件相對應的 File 對象。

示例：

Dim fSet f = fso.GetFile("c: est.txt") '變數f就代表了文件test.txt對象

注意：如果指定的文件不存在，則發生一個錯誤。

7、GetFileName 方法

語法：object.GetFileName(pathspec)

作用：返回指定路徑中的最後部件，該路徑不是驅動器說明的一部分。

示例：

Debug.Print fso.GetFileName("c:abc est.txt") '立即窗口顯示"test.txt"

8、GetFolder 方法

語法：object.GetFolder(folderspec)

作用：返回一個和指定路徑中文件夾相對應的 Folder 對象。

示例：

Dim fdSet fd = fso.GetFolder("c:windows") '變數f就代表了文件夾windows對象

注意：如果指定的文件夾不存在，則發生一個錯誤。

9、GetSpecialFolder 方法

語法：object.GetSpecialFolder(folderspec)

作用：返回指定的特殊文件夾。

說明：
folderspec 參數可為任何的下列值：

WindowsFolder 0 Windows 文件夾，包含由 Windows 操作系統安裝的文件。
SystemFolder 1 系統文件夾，包含庫、字體、設備驅動程序。
TemporaryFolder 2 Temp 文件夾，用於存儲臨時文件。它的路徑在 TMP 環境變數中。

10、GetParentFolderName 方法

語法：object.GetParentFolderName(path)

作用：返回一個包含指定路徑最後部件父文件夾名字的字元串。

示例：

Debug.Print fso.GetParentFolderName("c: mp est.txt") '顯示"c: mp"

11、GetTempName 方法

語法：object.GetTempName

作用：返回一個隨機產生的臨時文件或文件夾的名字，該名字在執行需要臨時文件或文件夾的操作時有用。

說明：GetTempName 方法不產生一個文件，它僅提供一個臨時文件名字，該名字可被 CreateTextFile 用於創建一個文件。

示例：

Debug.Print fso.GetTempName '顯示"radB0208.tmp",每次都會變。

12、BuildPath 方法

語法：object.BuildPath(path, name)

作用：追加一個名字到一個已經存在的路徑。

示例：

Debug.Print fso.BuildPath("c: mp", "abc") '顯示"c: mpabc"

13、CreateFolder 方法

語法：object.CreateFolder(foldername)

作用：創建一個文件夾。

注意：如果指定的文件夾已經存在，則發生一個錯誤。

示例：

fso.CreateFolder("c:myfolder") '在C盤創建一個myfolder文件夾

14、CopyFolder 方法

語法：object.CopyFolder source, destination[, overwrite]

source 必需的。指明一個或多個被復制文件夾的字元串文件夾說明，可以包括通配符。
destination 必需的。指明 source 中被復制文件夾和子文件夾的接受端的字元串，不允許有通配符。
overwrite 可選的。Boolean 值，它表示已存在的文件夾是否被覆蓋。如果為 True，文件被覆蓋。
如果為 False，文件不被覆蓋。預設值為 True。

作用：復制一個文件夾到另一個地方。

15、MoveFolder 方法

語法：object.MoveFolder source, destination

參數與CopyFolder的前兩個一樣。

作用：將一個或多個文件夾從一個地方移動到另一個地方。

16、DeleteFolder 方法

語法：object.DeleteFolder folderspec[, force]

folderspec 必需的。要刪除的文件夾的名字。 Folderspec 可以在最後的路徑部件中包含通配符。
force 可選的。Boolean 值，如果要刪除具有隻讀屬性設置的文件夾，其值為 True，
如果值為 False （預設），則不能刪除具有隻讀屬性設置的文件夾。

作用：刪除一個指定的文件夾和它的內容。

說明：如果沒有發現相匹配的文件夾，則發生一個錯誤。DeleteFolder 方法停止在它遇到的第一個錯誤上，不要嘗試回卷或撤消錯誤發生前所做的任何改變。

示例：

fso.DeleteFolder("c: mp")

17、FolderExists 方法

語法：object.FolderExists(folderspec)

作用：如果指定的文件夾存在返回 True，不存在返回 False。

18、DriveExists 方法

語法：object.DriveExists(drivespec)

作用：如果指定的驅動器存在，返回 True，如果不存在返回 False。

19、FileExists 方法

語法：object.FileExists(filespec)

作用：如果指定的文件存在，返回 True，若不存在，則返回 False。

20、CreateTextFile 方法

語法：object.CreateTextFile(filename[, overwrite[, unicode]])

overwrite 可選的。Boolean 值，表示一個已存在文件是否可被覆蓋。如果可被覆蓋其值為 True，
其值為 False 時不能覆蓋。如果它被省略，則已存在文件不能覆蓋。
unicode 可選的。Boolean 值，表示文件是作為一個 Unicode 文件創建的還是作為一個ASCII 文件創建的。
如果作為一個 Unicode 文件創建，其值為 True，作為一個 ASCII 文件創建，
其值為 False。如果省略的話，則認為是一個 ASCII 文件。

作用：創建一個指定的文件名並且返回一個用於該文件讀寫的 TextStream 對象。

示例：

Dim fSet
f = fso.CreateTextFile("c: estfile.txt", True)

21、OpenTextFile 方法

語法：object.OpenTextFile(filename[, iomode[, create[, format]]])

作用：打開一個指定的文件並返回一個 TextStream 對象，該對象可用於對文件進行讀、寫、追加操作。

說明：
·iomode 參數可為下面設置值中的任何值：

ForReading 1 打開一個只讀文件，不能對此文件進行寫操作。
ForWriting 2 打開一個用於寫操作的文件。如果和此文件同名的文件已存在，則覆蓋以前內容。
ForAppending8 打開一個文件並寫到文件的尾部。

注意：在VBA幫助里是沒有ForWriting的，其實是有的，VBA幫助也是有錯誤的。另外，這些常數在使用前要先聲明，或者直接用數值。

·create可選的，它表示如果指定的 filename 不存在是否可以創建一個新文件。如果創建新文件，其值為 True。若不創建文件其值為 False。預設值為 False。

·Format參數可為下面設置值中的任何值：

TristateUseDefault –2 使用系統預設打開文件。
TristateTrue –1 以 Unicode 格式打開文件。
TristateFalse 0 以 ASCII 格式打開文件。

示例：

Dim fSet
f = fso.OpenTextFile("c: estfile.txt", 2, True)

或者：

Const ForWriting = 2
Set f = fso.OpenTextFile("c: estfile.txt", ForWriting, True)

這兩者功能是一樣的，一個聲明了常量，一個直接用數值。都是在C盤創建文件testfile.txt（如不存在），或以寫的方式打開（如存在）。

22、CopyFile 方法

語法：object.CopyFile source, destination[, overwrite]

作用：把一個或多個文件從一個地方復制到另一個地方。

說明：需要注意的地方與CopyFolder是完全類似的。

示例：

fso.file "c: estfile.txt", "f:abc" '若abc不存在則出錯。
fso.file "c: estfile.txt", "f:abc" '若abc不存在則復制testfile.txt到F盤文件名變為abc，若abc存在，出錯，因為是一個目錄。

23、MoveFile 方法

語法：object.MoveFile source, destination

作用：將一個或多個文件從一個地方移動到另一個地方。

說明：需要注意的地方與MoveFolder是完全類似的。

24、DeleteFile 方法

語法：object.DeleteFile filespec[, force]

作用：刪除一個指定的文件。

說明：force 可選的。如果要刪除具有隻讀屬性設置的文件，其值為 True。如果其值為 False （預設），則不能刪除具有隻讀屬性設置的文件。

（三）處理文件夾

1、獲取文件夾的信息

可以利用Folder對象來獲取有關文件夾的信息，Folder對象的屬性有：

Attributes 屬性 文件夾的屬性。可為下列值中的任意一個或任意的邏輯組合：
Normal 0 一般文件。未設置屬性。
ReadOnly 1 只讀文件。屬性為讀/寫。
Hidden 2 隱藏文件。屬性為讀/寫。
System 4 系統文件。屬性為讀/寫。
Volume 8 磁碟驅動器卷標。屬性為只讀。
Directory 16 文件夾或目錄。屬性為只讀。
Archive 32 自上次備份後已經改變的文件。屬性為讀/寫。
Alias 64 鏈接或快捷方式。屬性為只讀。
Compressed 128 壓縮文件。屬性為只讀。
Name 屬性 文件夾名字。
ShortName 屬性 較早的 8.3 命名約定的程序所使用的短名字。
Type 屬性 文件夾類型。
Files 屬性 所有 File 對象組成的 Files 集合，這些 File 對象包含在指定的文件夾中
──包括設置了隱藏和系統文件屬性的那些文件。
Drive 屬性 文件夾所在的驅動器符號。
IsRootFolder 屬性 文件夾是否是根文件夾。
ParentFolder 屬性 文件夾的父文件夾對象。
SubFolders 屬性 文件夾的子文件夾集合。
Path 屬性 文件夾的路徑。
ShortPath 屬性 較早的 8.3 文件命名約定的程序所使用的短路徑。
Size 屬性 文件夾的大小，以位元組為單位。
DateCreated 屬性 文件夾的創建日期和時間。
DateLastModified 屬性 最後一次修改文件夾的日期和時間。
DateLastAccessed 屬性 最後一次訪問文件夾的日期和時間。

屬性的使用和Drive對象是一樣的，可以用GetFolder獲取一個Folder對象，也可以用FileSystemObject對象的CreateFolder 方法創建一個Folder對象。

2、Folder對象的方法

⑴Copy 方法

語法：object.Copy destination[, overwrite]

作用：把一個指定的文件夾從一個地方復制到另一個地方。

說明：Copy 方法的作用與FileSystemObject對象的CopyFolder 方法是一樣的，不同在於後者可一次復制多個文件夾。

⑵Move 方法

語法：object.Move destination

作用：將一個指定的文件夾從一個地方移動到另一個地方。

說明：Move 方法的作用與FileSystemObject.MoveFolder 是一樣的。不同在於後者可一次移動多個文件夾。

⑶Delete 方法

語法：object.Delete force

作用：刪除一個指定的文件夾。

說明：Delete 方法的作用與FileSystemObject.DeleteFolder 是一樣的。

⑷CreateTextFile 方法

語法：object.CreateTextFile(filename[, overwrite[, unicode]])

作用：與FileSystemObject對象的CreateTextFile 方法是一樣的。

示例：

Setfd=fs.getfolder("c:	mp")
Setf=fd.CreateTextFile("testfile.txt",True)

可在C盤tmp文件夾下創建testfile.txt文件。

（四）處理文件

1、獲取文件的信息

可以利用File對象來獲取有關文件的信息，File對象的屬性和Folder的屬性是完全一樣的，只是少了Files 屬性、IsRootFolder 屬性、SubFolders 屬性這3個屬性。這里就不列了。

2、File對象的方法

⑴Copy 方法

⑵Move 方法

⑶Delete 方法

以上三種方法與Folder的是完全類似的，語法也一樣，同樣也可用FileSystemObject對象相應的方法代替。

⑷OpenAsTextStream 方法

語法：object.OpenAsTextStream([iomode, [format]])

作用：打開一個指定的文件並返回一個 TextStream 對象，該對象可用來對文件進行讀、寫、追加操作。

說明：此方法與FileSystemObject對象的 OpenTextFile 方法相同的功能。參數也是一致的。

總結

從上面的介紹，我們看到使用FileSystemObject對象處理文件、文件夾比使用VBA語句的方法具有更容易存在的特點。這是因為FileSystemObject對象使用了面向對象的語法。另外FileSystemObject對象處理文本文件毫不遜色於VBA語句，非常值得推薦。唯一的問題是不能處理二進制文件，微軟在有關文檔中稱計劃將來支持二進制文件，不過應該只是計劃而已。

通過介紹完FileSystemObject的知識，可參考以下代碼是通過FileSystemObject對象模型遍歷指定文件夾，然後打開該文件和另外的excel，實現兩個excel的數據之間操作。

SubTest()
Application.DisplayAlerts=False'禁止信息提示
Application.ScreenUpdating=False'禁止屏幕刷新
mypath=Sheets(1).Range("B2").Value'文件夾路徑

ForEachDeleFileInCreateObject("scripting.filesystemobject").getfolder(Sheets(1).Range("B3").Value).Files'遍歷文件夾下的所有文件
DeleFile.Delete'刪除每遍歷一次的文件
Next

ForEachmyfileInCreateObject("scripting.FileSystemObject").getfolder(mypath).Files'遍歷文件夾下的所有文件

Ifmyfile.NameLike"*.xlsx*"Then'篩選excel文件

Filename=Mid(myfile.Name,1,(InStr(myfile.Name,"_")-1))'獲取文件名

WithWorkbooks.Open(Op.Range("B1").Value&""&Op.Range("C1").Value)'打開另一個excel文件為A

Setwb=Workbooks(Op.Range("C1").Value).Worksheets(1)'設置A的workbook為wb

WithGetObject(myfile)'打開當前遍歷的excel文件為B
wb.Range("A1").Value=.Sheets(1).Range("C1").Value'將B的C1單元格值賦給A的A1單元格
.Close'關閉B
EndWith
.SaveAsFilename:=Op.Range("B3")&""&Filename&".xlsx",_
FileFormat:=xlOpenXMLWorkbook,CreateBackup:=False'另存為excel文件

.CloseFalse'關閉A
EndWith
EndIf

Next
Application.DisplayAlerts=True'恢復信息提示
Application.ScreenUpdating=True'恢復屏幕刷新
EndSub

⑸ 在vba中使用什麼函數可以實現遍歷文件夾和文件的需求,並得到指定路徑下的文件

可參考截圖的代碼試試。

vb對文件夾、及文件的訪問

⑹ EXCEL VBA 遍歷所有文件夾和子文件夾的文件中指定單元格中的數據，匯總到一張工作表中，

把需要遍歷的所有路徑，寫到一個excel表裡不就行了，每次從這個表裡調用路徑去遍歷。或者dir /b /s *.xls*>d:\1.txt，把這個1.txt內容讀入表或數組，遍歷這個就行了。

⑺ 怎麼用vba遍歷文件夾里的所有文件

遍歷操作，一般運用於提取和寫入等的操作，其基本原理和代碼都一樣，

遍歷的方法也有很多種，以下我提供一種方法open法，除去紅框以內

的代碼基本都是遍歷的基礎代碼，在這個基礎上可以做根據實際需要的添加修改

⑻ 如何用VBA遍歷指定文件夾內的所有文件

用dir函數加上循環即可。比如將D:ABC文件夾內的所有文件顯示到A列，代碼如下：

Sub遍歷所有文件()
DimFn$,N%
Fn=Dir("D:ABC*.*")
WhileFn<>""
N=N+1
Range("A"&N)=Fn
Fn=Dir
Wend
EndSub

⑼ vba讀取excel遍歷文件指定數據

Excel文件格式一致，匯總求和，其他需求自行變通容
匯總使用了字典

Public d
Sub 按鈕1_Click()
Application.ScreenUpdating = False
ActiveSheet.UsedRange.ClearContents
Cells(1, 1) = "編號"
Cells(1, 2) = "數量"
Set d = CreateObject("scripting.dictionary")
Getfd (ThisWorkbook.Path) 'ThisWorkbook.Path是當前代碼文件所在路徑，路徑名可以根據需求修改
Application.ScreenUpdating = True
If d.Count > 0 Then
ThisWorkbook.Sheets(1).[a2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
ThisWorkbook.Sheets(1).[b2].Resize(d.Count) = WorksheetFunction.Transpose(d.items)
End If
End Sub
Sub Getfd(ByVal pth)

Set Fso = CreateObject("scripting.filesystemobject")
Set ff = Fso.getfolder(pth)
For Each f In ff.Files
Rem 具體提取哪類文件，還是需要根據文件擴展名進行處理
If InStr(Split(f.Name, ".")(UBound(Split(f.Name, "."))), "xl") > 0 Then
If f.Name <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(f)
For Each sht In wb.Sheets
If WorksheetFunction.CountA(sht.UsedRange) > 1 Then
arr = sht.UsedRange
For j = 2 To UBound(arr)
d(arr(j, 1)) = d(arr(j, 1)) + arr(j, 2)
Next j
End If
Next sht
wb.Close False
End If
End If
Next f
For Each fd In ff.subfolders
Getfd (fd)
Next fd
End Sub

⑽ 如何用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試試