遞歸文件夾目錄層級vba

⑴ 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對文件夾和文件排序

用VBA處理
沒有問題
。
但
你的問題
比較抽象，對哪一個文件夾、排序條件優先
次序
，用EXCEL中的VBA還是WORD？未明確，故編寫有點！？！
因為剛看到你的提問，時間太緊，你把問題更具體一點，告訴郵箱地址，我把答案發給你。
補充：
附件的宏已經能夠把指定的文件夾中的（包括子文件夾）所有文件遍歷，信息保存在
工作表
中，並按要求排序。
當然可以做到，不用寫入
路徑
，採用
滑鼠
點擊訪問文件夾。因時間來不及，有空改寫後發給你。
附件：遍歷文件並排序.xls

⑶ 求助]如何用VBA遍歷指定目錄下的所有子文件夾和文件-字典模式

F是一個臨時邏輯變數，在循環查找工作簿中是否有名為「XLS文件清單」的工作表，找到為「真」，否則為假。目的是方便後續的代碼處理，如果沒有這個工作表，則先創建建這個工作表，後面才能放置遍歷出來的文件夾及文件名。

⑷ VBA實現遞歸遍歷所選中的路徑，並將該路徑下文件及子文件夾中所有文件路徑列出在第一列，求大神幫忙。

您能提出這等 問題說明您的VBA水平有一定火候了，請看
Function Fllst(Pth$)
Dim Fso As Object
Dim Fld, Fl
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fld = Fso.getfolder(Pth)
On Error Resume Next

For Each Fl In Fld.Files
[A65536].End(3)(2) = Fl.path
Next
For Each Fl In Fld.SubFolders
Fllst (Fl.path)
Next
End Function

Sub getList()
Dim Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
[A:A].ClearContents
Application.ScreenUpdating = False
Fllst (CreateObject("Shell.Application").BrowseForFolder(0, "請選擇目錄", 0, "").Self.path)
Application.ScreenUpdating = True
Set Fso = Nothing
End Sub

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

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

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

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

⑹ 如何用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

⑺ 如何用VBA遍歷指定目錄下的所有子文件夾Excel文件的所有工作表

下面的代碼是手工碼的，不曉得有沒有問題。

subtest()
dimfasstring,mPathasstring,Wbasworkbook,ShasworkSheet
ifworkbooks.count>1thenmsgbox"關閉其他工作簿！":exitsub
mPath="D:臨時文件夾"'指定路徑，注意分層標記
f=dir(mPath&"*.xls*")
dowhilef<>""
iff<>thisworkbook.namethen
setWb=workbooks.open(mPath&f)'只讀方式打開
withWb
foreachShin.workSheets
'對工作表進行操作的代碼段，自己寫。
next
endwith
wb.close0'關閉文件
endif
f=dir'枚舉,以訪問下一個工作簿。
loop
endsub

⑻ 如何通過VBA快速尋找到文件夾及其中的子文件夾，並建立超鏈接。多謝！

Sub ABC()
Dim Sph
Sph = Dir("D:\data\*" & Cells(1, 1) & "*", 16)
If Sph = "" Then Exit Sub
Sph = "D:\data\" & Sph & "\"
Dir Sph, 16
Dir
Do
co = co + 1
sph1 = Dir()
If sph1 = "" Then Exit Do
Cells(2, co) = sph1
ActiveSheet.Hyperlinks.Add Cells(2, co), Sph & sph1
Loop
For i = 1 To co - 1
If Dir(Sph & Cells(2, i) & "\*") <> "" Then
ro = 3
Do
fi = Dir()
If fi = "" Then Exit Do
Cells(ro, i) = fi
ActiveSheet.Hyperlinks.Add Cells(ro, i), Sph & Cells(2, i) & "\" & fi
ro = ro + 1
Loop
End If
Next
End Sub

以上代碼可滿足你的要求。有問題請追問

⑼ 在excal中如何用vba實現目錄樹

不知道你想怎麼實現？既然沒有說明，那就隨便做好了。
用遞歸循環所有目錄，主目錄寫在A列，子目錄依次寫在B、C.....之內就達到你的目的了

⑽ excel用vba指定同級目錄下的子目錄文件

Sub aRef()
Dim i As Long
Dim fs As Object
Set fs = Application.FileSearch
With fs
'設置要查找的起始目錄
.LookIn = "E:\My Documents\Downloads" 『』查找的文件夾
'要查找的文件類型
.FileType = msoFileTypeExcelWorkbooks
'是否查找子目錄
.SearchSubFolders = True
'根據上面的設置執行查找
.Execute
For i = 1 To .FoundFiles.Count
'遍歷打開找到的EXCEL文件
Cells(i, 1) = .FoundFiles(i) ''excel文件的路徑
'其它處理
'.....
Next i
End With
End Sub