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文件清單」的工作表，找到為「真」，否則為假。目的是方便後續的代碼處理，如果沒有這個工作表，則先創建建這個工作表，後面才能放置遍歷出來的文件夾及文件名。