vbadir子文件夾
① 如何用VBA遍歷指定目錄下的所有子文件夾Excel文件的所有工作表
vba麻煩點，dir最快，excelhome論壇上有大量現成代碼：
SubOpiona()'//函數實例
FileArr=FileAllArr(ThisWorkbook.Path,"*.xls",ThisWorkbook.Name,False)
Fori=0ToUBound(FileArr)
MsgBoxFileArr(i)
'SetWB=Workbooks.Open(FileArr(I))'//打開工作簿
'你的代碼
'WB.Closetrue'//保存
Next
EndSub
'*******************************************************************************************************
'功能：查找指定文件夾含子文件夾內所有文件名或文件夾名（含路徑）
'函數名：FileAllArr
'參數1：Filename需查找的文件夾名不含最後的""
'參數2：FileFilter需要過濾的文件名，可省略，默認為：[*.*]
'參數3：Liwai剔除例外的文件名，可省略，默認為：空，一般為：ThisWorkbook.Name
'參數4：Files是否只要文件夾名，可省略，默認為：FALSE
'返回值：一個字元型的數組
'使用方法：FileArr=FileAllArr(ThisWorkbook.Path,"*.xls",ThisWorkbook.Name,false)
'作者:北極狐工作室QQ：14885553
'*******************************************************************************************************
PublicFunctionFileAllArr(ByValFilenameAsString,="*.*",OptionalByValLiwaiAsString="",OptionalByValFilesAsBoolean=False)AsString()
SetDic=CreateObject("Scripting.Dictionary")'創建一個字典對象
SetDid=CreateObject("Scripting.Dictionary")
Dic.Add(Filename&""),""
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
Dimarrx()AsString
i=0
IfFiles=TrueThen'//是否只輸出文件夾名
ForEachKeInDic.keys'以查找總表所在文件夾下所有excel文件為例
ReDimPreservearrx(i)
IfKe<>Filename&""Then'//自身文件夾除外
arrx(i)=Ke
i=i+1
EndIf
Next
FileAllArr=arrx
Else
ForEachKeInDic.keys'以查找總表所在文件夾下所有excel文件為例
MyFileName=Dir(Ke&FileFilter)'過濾器：EXCEL2003為：*.xls,excel2007為：*.xlsx
DoWhileMyFileName<>""
IfMyFileName<>LiwaiThen'排除例外文件
ReDimPreservearrx(i)
arrx(i)=Ke&MyFileName
i=i+1
EndIf
MyFileName=Dir
Loop
Next
FileAllArr=arrx
EndIf
EndFunction
'****************************************************************
② 怎樣用vba取得子文件夾一覽
用DIR這個函數來列出某個文件夾下的內容,
以excel里的為例
Dim i As Integer
i = 1
Sheet1.Range("A" & i) = Dir("C:\")
Do While True
i = i + 1
Sheet1.Range("A" & i) = Dir
If Sheet1.Range("A" & i) = "" Then Exit Do
Loop
③ 如何用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代碼如何獲得指定文件夾內的所有子文件夾名稱
Set fso=CreateObject("Scripting.FileSystemObject")
Set folder=fso.GetFolder("D:")
dim a() as string
dim b
b=1
for each thing in folder.subfolders
addfolder fso,thing,a,b
next
msgbox b
function addfolder(byref fso,byref dir,byref a,byref b)
set folder=fso.getfolder(dir)
a(b)=dir
b=b+1
For Each thing in folder.SubFolders
set folder=fso.getfolder(thing)
a(b)=thing
b=b+1
addfolder fso,thing,a,b
Next
end function
⑤ 在VBA中用Dir歷遍包含子文件夾的所有文件，指定文件類型後就不歷遍子文件夾了。請大神之招。代碼如下：
SubScearchFiles_AndSub()
Dimx%,i%
WithApplication.FileDialog(msoFileDialogFolderPicker)
If.Show=-1Then
P=.SelectedItems(1)
IfRight(P,1)=""ThenP=PElseP=P&""
EndIf
EndWith
'------------------------------------------------------------------------------
SetFolderList=CreateObject("Scripting.Dictionary")
FolderList.AddP,""
i=0
DoWhilei<FolderList.Count
Ke=FolderList.Keys
'FName=Dir(FolderName,vbDirectory+vbHidden+vbNormal)
FName=Dir(Ke(i),vbDirectory)
DoWhileFName<>""
IfFName<>".."AndFName<>"."Then
IfGetAttr(Ke(i)&FName)AndvbDirectoryThen
FolderList.Add(Ke(i)&FName&""),""
EndIf
EndIf
FName=Dir
Loop
i=i+1
Loop
'------------------------------------------------------------------------------
ForEachFnInFolderList.Keys
FName=Dir(Fn&"*.pdf")
DoWhileFName<>""
Cells(x+1,1)=FName
x=x+1
FName=Dir
Loop
Next
EndSub
⑥ EXCEL VBA Dir 函數
這是文件系統發回給DIr的，一個點代表的是本級目錄，兩個點代表的是上級目錄。他們以「文件」的方式保存在這個子文件夾的文件表裡面用以保存自身的存放位置和與上級目錄的關聯
你需要自行鑒別獲得的數據（包括可能的子文件夾）
⑦ 在VBA中用DIR函數遍歷子文件夾出錯
圖片彈出的意思是：無效的過程調用。
dir是vba內置函數，需要參數運行。
⑧ Excel VBA列出某文件夾下子文件夾及文件名
遍歷文件夾 並列出文件 & 文件夾 名 代碼如下：
在文件夾內 新建 個 Excel文件
Excel文件內 按 Alt+F11 視圖--代碼窗口， 把如下代碼復制進去， F5運行
Sub遍歷文件夾()
'OnErrorResumeNext
Dimfn(1To10000)AsString
Dimf,i,k,f2,f3,x
Dimarr1(1To100000,1To1)AsString,qAsInteger
Dimt
t=Timer
fn(1)=ThisWorkbook.path&""
i=1:k=1
DoWhilei<UBound(fn)
Iffn(i)=""ThenExitDo
f=Dir(fn(i),vbDirectory)
Do
IfInStr(f,".")=0Andf<>""Then
k=k+1
fn(k)=fn(i)&f&""
EndIf
f=Dir
LoopUntilf=""
i=i+1
Loop
'*******下面是提取各個文件夾的文件***
Forx=1ToUBound(fn)
Iffn(x)=""ThenExitFor
f3=Dir(fn(x)&"*.*")
DoWhilef3<>""
q=q+1
arr1(q,1)=fn(x)&f3
f3=Dir
Loop
Nextx
ActiveSheet.UsedRange=""
Range("a1").Resize(q)=arr1
MsgBoxFormat(Timer-t,"0.00000")
EndSub
效果如圖：
⑨ 如何用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復制整個文件夾包括子目錄
Sub Files(Path As String, afterPath)
'Path：原文件夾路徑；afterPath：目標文件夾路徑
Dim Spath As String
Set fs = CreateObject("Scripting.FileSystemObject")
Spath = Dir(Path, vbDirectory)
Do While Len(Spath)
If Spath <> "." And Spath <> ".." Then
fs.CopyFolder Path, afterPath
Spath = Dir()
End If
Loop
End Sub
————————————————
版權聲明：本文為CSDN博主「前端小菜鳥007」的原創文章，遵循CC 4.0 BY-SA版權協議，轉載請附上原文出處鏈接及本聲明。
原文鏈接：https://blog.csdn.net/weixin_41844140/article/details/103188537