vba復制文件夾包括子目錄

1. 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

2. EXCEL VBA 獲取文件夾及子文件夾下所有文件並建立超鏈接

還沒有解決嗎？那我就來試一下。

（1）首先，樓主先新建一個excel，名稱樓主自己寫，怎樣都行，然後將其打開。

（2）打開後按住Alt再按F11，這樣就會打開vba代碼編輯器

（3）點菜單欄上的「插入」，選擇「模塊」，這樣在左下角就會出現一個「模塊1」

（4）雙擊「模塊1」，右邊就會出現「模塊1」的編輯界面，將以下代碼復制，並粘貼到這個界面中，按F5運行。

Sub遍歷文件夾()
'Columns(1).Delete
OnErrorResumeNext
DimfAsString
Dimfile()AsString
Dimi,k,x
x=1
i=1:k=1
ReDimfile(1Toi)
file(1)=InputBox("請輸入要查找的文件夾：")&""
DoUntili>k
f=Dir(file(i),vbDirectory)
DoUntilf=""
IfInStr(f,".")=0Then
k=k+1
ReDimPreservefile(1Tok)
file(k)=file(i)&f&""
EndIf
f=Dir
Loop
i=i+1
Loop
Fori=1Tok
f=Dir(file(i)&"*.*")
DoUntilf=""
'Range("a"&x)=f
Range("a"&x).Hyperlinks.AddAnchor:=Range("a"&x),Address:=_
file(i)&f,TextToDisplay:=f
x=x+1
f=Dir
Loop
Next
EndSub

（5）在出現的對話框中，將你要查找的文件的地址復制到對話框中，按確定，就完成了。

註：這里用的是excel2007版，如果樓主用的是其他版本，有可能存在代碼不兼容問題。

圖3.結果。

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

4. 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

效果如圖：