求教如何用VBA遍历文件夹里的子文件夹里的所有文件

yang1992820

求教下大家，我有一个文件夹，里面有很多子文件夹，我需要遍历子文件夹里的所有Excel文件。用dir 但是套在一起发现好像不行

shiruiqiang

提取子文件夹名，并把这些子文件夹名加入遍历路径

shiruiqiang

常用代码。论坛里的老师写的

Set f = fso.getfolder(ThisWorkbook.Path)

For Each fd In f.subfolders

    n = n + 1

    ReDim Preserve arr(1 To n)

    arr(n) = fd.Name

Next

Set f = Nothing

Set fso = Nothing

For i = 1 To n

    f = Dir(ThisWorkbook.Path & "\" & arr(i) & "\*.xls*")

    Do While f <> ""

opel-wong

供参考：

ykcbf1100

上传附件，应能更快解决问题。这不是难题，是常规操作。
上传的附件可以摸拟几个文件夹，几个文件就行

fzxba

Sub test0() '
  Dim strPath As String
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = ThisWorkbook.Path
    If .Show Then strPath = .SelectedItems(1) Else Exit Sub
  End With
  If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
  'strPath = ThisWorkbook.Path & "\"
  
  Dim strFolder As String, strFile As String
  Dim ar() As String, Dict As Object
  Dim i As Long, j As Long, k
  
  Set Dict = CreateObject("Scripting.Dictionary")
  Dict.Add strPath, vbNullString
  While i < Dict.Count
    k = Dict.Keys
    strFolder = Dir(k(i), vbDirectory)
    While strFolder <> vbNullString
      If strFolder <> "." And strFolder <> ".." Then
        If (GetAttr(k(i) & strFolder) And vbDirectory) = vbDirectory Then
          Dict.Add k(i) & strFolder & "\", vbNullString
        End If
      End If
      strFolder = Dir()
    Wend
    i = i + 1
  Wend
  For Each k In Dict.Keys
    strFile = Dir(k & "*.xls*")
    While Len(strFile)
      If k & strFile <> ThisWorkbook.FullName Then
        j = j + 1
        ReDim Preserve ar(1 To j)
        ar(j) = k & strFile
      End If
      strFile = Dir()
    Wend
  Next
  Set Dict = Nothing
  
  For i = 1 To j
    '遍历开始，请准备好你的操作方式
    Debug.Print ar(i)
  Next
  
End Sub

x-xx-xx

文件 遍历 递归

sj15627581616

这是我写在类里面的cmd dir命令，可以参考修改使用

gwjkkkkk

搜一下，坛了现成的很多。。。

lizhipei78