目前样子只有两层目录，两层以上目录暂未考虑。
=================================
Sub 批量插入多个文件夹内的图片()
On Error Resume Next
Dim f As String
Dim file() As String
Dim i，k，x，fp
i = 1: k = 1
Dim fd As FileDialog
With fd
.InitialFileName = ActiveWorkbook.Path
End With
ReDim file(1 To i)
file(1) = fp & &34;
Do Until i > k
f = Dir(file(i)，vbDirectory)
Do Until f = &34;
If InStr(f，&34;) = 0 Then
k = k + 1
ReDim Preserve file(1 To k)
file(k) = file(i) & f & &34;
End If
f = Dir
Loop
i = i + 1
Loop
For i = 2 To k
Set wkb = Documents.Add '新建文件
fn = file(i) & &34; '生成文件名
ActiveDocument.SaveAs fn '保存文件
Call 批量插入图片
wkb.Save
wkb.Close
Next
End Sub
