如何用VBA遍历指定文件夹内的所有文件

用顷让dir函数汪乎拦加上循环即可。比如将D:\ABC文件夹内的所有文件显示到A列，代码如下：

Sub 遍历所有文件()

Dim Fn$, N%

Fn = Dir("D:\ABC\*.*")

While Fn <> ""

 困胡  N = N + 1

   Range("A" & N) = Fn

   Fn = Dir

Wend

End Sub

Sub Test()

    Dim MyName, Dic, Did, I, T, F, TT, MyFileName

    T = Time

    Set Dic = CreateObject("Scripting.Dictionary")    '创建一携肢个字典对象

    Set Did = CreateObject("Scripting.Dictionary")

    Dic.Add ("D:\My Documents\"), ""

    I = 0

    Do While I < Dic.Count

        Ke = Dic.keys   '开始遍历字典

        MyName = Dir(Ke(I), vbDirectory)    '查找目录

        Do While MyName <> ""

            If MyName <> "." And MyName <> ".." Then

                If (GetAttr(Ke(I) & MyName) And vbDirectory) = vbDirectory Then    '如果是次级目录

                    Dic.Add (Ke(I) & MyName & "\"), ""  '就往字典中添加这个次级目录名作为一个条目

            培茄    End If

            End If

            MyName = Dir    '继续遍历寻找

        Loop

        I = I + 1

    Loop

    Did.Add ("文件清单"), ""    '以查找D盘My Documents下所有EXCEL文件为例

    For Each Ke In Dic.keys

        MyFileName = Dir(Ke & "*.xls")

        Do While MyFileName <> ""

            Did.Add (Ke & MyFileName), ""

            MyFileName = Dir

        Loop

    Next

    For Each Sh In ThisWorkbook.Worksheets

        If Sh.Name = "XLS文件清单辩中世" Then

            Sheets("XLS文件清单").Cells.Delete

            F = True

            Exit For

        Else

            F = False

        End If

    Next

    If Not F Then

        Sheets.Add.Name = "XLS文件清单"

    End If

    Sheets("XLS文件清单").[A1].Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.keys)

    TT = Time - T

    MsgBox Minute(TT) & "分" & Second(TT) & "秒"

End Sub

尝试用下边代码试试：

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试试

---