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

遍历文件夹 并列出文件 &文件夹 名 代码如下：

在文件夹内 新建 个 Excel文件

Excel文件内 按 Alt+F11 视图--代码窗口， 把如下代码复制进去， F5运行

Sub 遍历文件夹()

  'On Error Resume Next

  Dim fn(1 To 10000) As String

  Dim f, i, k, f2, f3, x

  Dim arr1(1 To 100000, 1 To 1) As String, q As Integer

  Dim t

  燃返t = Timer

  fn(1) = ThisWorkbook.path & "\"

  i = 1: k = 1

  Do While i < UBound(fn)

    If fn(i) = ""皮粗饥 Then Exit Do

    f = Dir(fn(i), vbDirectory)

    Do

      If InStr(f, ".") = 0 And f <> "" Then

        k = k + 1

        fn(k) = fn(i) & f & "\"

      End If

      f = Dir

    Loop Until f = ""

    i = i + 1

  Loop

  '*******下面是提取各个文件夹的文件***

  For x = 1 To UBound(fn)

      If fn(x) = "" Then Exit For

       f3 = Dir(fn(x) & "*.*")

     Do While f3 <> ""

       q = q + 1

       arr1(q, 1) = fn(x) & f3

       f3 = Dir

     Loop

  Next x

  ActiveSheet.UsedRange = ""凳模

  Range("a1").Resize(q) = arr1

  MsgBox Format(Timer - t, "0.00000")

End Sub

效果如图：

用FileSearch功能，给个例旅乎子，自己研究一下：

Sub

test()

With

Application.FileSearch

'寻找的目录是当前工作薄拆让悉所在的目录

.LookIn

=

ThisWorkbook.Path

'只寻找文件,不寻找下级目录

.SearchSubFolders

=

False

'要找的文件是XLS文件

.FileType

=

msoFileTypeExcelWorkbooks

'寻找

.NewSearch

'如果找到文件，.execute()将大于0

'找到的文件总数是.foundFilescount

'以下是把找到的文件名称全部显示在表滑洞格中

If

.Execute()

>

0

Then

For

i

=

1

To

.FoundFiles.Count

Cells(i,

1)

=

.FoundFiles(i)

Next

End

If

End

With

End

Sub

---