在VBA中用Dir历遍包含子文件夹的所有文件，指定文件类型后就不历遍子文件夹了。请大神之招。代码如下：

Sub ScearchFiles_AndSub()

    Dim x%, i%

    With Application.FileDialog(msoFileDialogFolderPicker)

        If .Show = -1 Then

            P = .SelectedItems(1)

            If Right(P, 1) = "\" Then P = P Else P = P & "\"

        End If

    End With

'------------------------------------------------------------------------------

    Set FolderList = CreateObject("Scripting.Dictionary")

    FolderList.Add P, ""

    i = 0

    Do While i < FolderList.Count

        Ke = FolderList.Keys

        'FName = Dir(FolderName, vbDirectory + vbHidden + vbNormal)

        FName = Dir(Ke(i), vbDirectory)

            Do While FName <> ""

                If FName <> ".." And FName <> "." Then

                    If GetAttr(Ke(i) & FName) And vbDirectory Then

                        FolderList.Add (Ke(i) & FName & "\"), ""

                    End If

                End If

                FName = Dir

            Loop

        i = i + 1

    Loop

'------------------------------------------------------------------------------

    For Each Fn In FolderList.Keys

        FName = Dir(Fn & "*.pdf")

        Do While FName <> ""

            Cells(x + 1, 1) = FName

            x = x + 1

            FName = Dir

        Loop

    Next

End Sub

【引用位置】 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

下面的代码是手工码的，不晓得有没有问题。

sub test()

dim f as string,mPath as string,Wb as workbook,Sh as workSheet

if workbooks.count>1 then msgbox "关闭其他工作簿！":exit sub

mPath = "D:\临时文件夹\" '指定路径，注意分层标记\

f=dir(mPath & "*.xls*")

do while f<>""

    if f<>thisworkbook.name then

    set Wb=workbooks.open(mPath & f)  '只读方式打开

    with Wb

          for each Sh in .workSheets

          '对工作表进行 *** 作的代码段，自己写。

          next

    end with

    wb.close 0  '关闭文件

    end if

f=dir  '枚举,以访问下一个工作簿。

loop

end sub

---