代码注释：遍历所有文件夹的两种方法（filesearch和FileSystemObject）

兰色幻想

        在VBA遍历文件夹和子文件夹中所有文件，常用两种方法，一种是使用VBA的filesercth对象，另外一种是使用FileSystemObject(windows文件管理工具)和递归方法。兰色对代码进行了注解，希望对大家有所帮助

    第一种方法：使用filesearch对象

           Sub mysearch()
Dim fs, i, arr(1 To 10000)
Set fs = Application.FileSearch '设置一个搜索对象
With fs
    .LookIn = ThisWorkbook.Path & "/" '设置搜索路径
    .Filename = "*.xls"  '要搜索文件名和类型
    .SearchSubFolders = True  '是否需要搜索子文件夹
    If .Execute > 0 Then  '如果找不到文件
        MsgBox "There were " & .FoundFiles.Count & _
        " file(s) found."  '显示文件找不到
        For i = 1 To .FoundFiles.Count  '通过循环把所有搜索到的文件存入到数组中
          arr(i) = .FoundFiles(i)
       Next i
Sheets(1).Range("A1").Resize(.FoundFiles.Count) = Application.Transpose(arr) '  '把数组内的路径和文件名放在单元格中
    Else
        MsgBox "There were no files found."
    End If
End With
End Sub

第二种方法：引用FileSystemObject对象

    注意：要使用FileSystemObject对象，需要首先引用一下，具体方法，VBE--工具--引用--找到miscrosoft scription runtime项目并选中

   代码及注释：

        Dim ArrFiles(1 To 10000) '创建一个数组空间,用来存放文件名称
Dim cntFiles% '文件个数

Public Sub ListAllFiles()
       
        Dim strPath$  '声明文件路径
        Dim i%
       'Set fso = CreateObject("Scripting.FileSystemObject")
        Dim fso As New FileSystemObject, fd As Folder  '创建一个FileSystemObject对象和一个文件夹对象

        strPath = ThisWorkbook.Path & "\" '"设置要遍历的文件夹目录
        cntFiles = 0
        Set fd = fso.GetFolder(strPath) '设置fd文件夹对象
        SearchFiles fd '调用子程序查搜索文件
        Sheets(1).Range("A1").Resize(cntFiles) = Application.Transpose(ArrFiles) '把数组内的路径和文件名放在单元格中

End Sub

 

Sub SearchFiles(ByVal fd As Folder)

    Dim fl As File
    Dim sfd As Folder
    For Each fl In fd.Files   '通过循环把文件逐个放在数组内
      cntFiles = cntFiles + 1
      ArrFiles(cntFiles) = fl.Path
    Next fl
  
    If fd.SubFolders.Count = 0 Then Exit Sub 'SubFolders返回由指定文件夹中所有子文件夹（包括隐藏文件夹和系统文件夹）组成的 Folders 集合

    For Each sfd In fd.SubFolders '在 Folders 集合进行循环查找
      SearchFiles sfd '使用递归方法查找下一个文件夹
    Next
  
End Sub

[此贴子已经被作者于2010-6-22 14:54:39编辑过]

那么的帅

沙发

帅

谢谢兰版[em04][em04][em04]

jiacheng2010

谢谢兰讲师！学习

nichangdong

[em01][em01]

bear_xjl

谢谢兰老师，
第二个好用，能不能再添加文件筛选，在每个单元格里再添加超级链接那就完美了。

fksd1

父子转换法，呵呵！

我心飞翔410

谢谢兰版

hbjyzsf

很好，谢谢兰版

开心萝卜惠州

谢谢兰版，学习！