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

效果如图：