VBA遍历文件夹的三种方法(转载)
2015-06-26 18:34
621 查看
<span style="font-size:14px;">VBA遍历文件夹常用有三种方法,这三种方法中,filesearch不适合2007和2010版本,而且速度比较慢,递归法速度也慢。只有用DIR加循环的方法,速度飞快。下面是三种方法的代码: 1、filesearch法 Sub test3() Dim wb As Workbook Dim i As Long Dim t t = Timer With Application.FileSearch '调用fileserch对象 .NewSearch '开始新的搜索 .LookIn = ThisWorkbook.path '设置搜索的路径 .SearchSubFolders = True '搜索范围包括 LookIn 属性指定的文件夹中的所有子文件夹 .Filename = "*.xls" '设置搜索的文件类型 ' .FileType = msoFileTypeExcelWorkbooks If .Execute() > 0 Then '如果找到文件 For i = 1 To .FoundFiles.Count 'On Error Resume Next Cells(i, 1) = .FoundFiles(i) '把找到的文件放在单元格里 Next i Else MsgBox "没找到文件" End If End With MsgBox Timer - t End Sub 2、递归法 Sub Test() Dim iPath As String, i As Long Dim t t = Timer With Application.FileDialog(msoFileDialogFolderPicker) .Title = "请选择要查找的文件夹" If .Show Then iPath = .SelectedItems(1) End If End With If iPath = "False" Or Len(iPath) = 0 Then Exit Sub i = 1 Call GetFolderFile(iPath, i) MsgBox Timer - t MsgBox "文件名链接获取完毕。", vbOKOnly, "提示" End Sub Private Sub GetFolderFile(ByVal nPath As String, ByRef iCount As Long) Dim iFileSys 'Dim iFile As Files, gFile As File 'Dim iFolder As Folder, sFolder As Folders, nFolder As Folder Set iFileSys = CreateObject("Scripting.FileSystemObject") Set iFolder = iFileSys.GetFolder(nPath) Set sFolder = iFolder.SubFolders Set iFile = iFolder.Files With ActiveSheet For Each gFile In iFile ' .Hyperlinks.Add anchor:=.Cells(iCount, 1), Address:=gFile.path, TextToDisplay:=gFile.Name iCount = iCount + 1 Next End With '递归遍历所有子文件夹 For Each nFolder In sFolder Call GetFolderFile(nFolder.path, iCount) Next End Sub 3、dir循环法 Sub Test() '使用双字典,旨在提高速度 Dim MyName, Dic, Did, i, t, F, TT, MyFileName 'On Error Resume Next Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0) If Not objFolder Is Nothing Then lj = objFolder.self.path & "\" Set objFolder = Nothing Set objShell = Nothing t = Time Set Dic = CreateObject("Scripting.Dictionary") '创建一个字典对象 Set Did = CreateObject("Scripting.Dictionary") Dic.Add (lj), "" 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盘下所有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 </span>
原文地址:http://www.excelpx.com/home/show.aspx?id=33930
相关文章推荐
- 【VBA研究】工作表自动筛选模式检测
- cvBoostStartTraining
- VB远程屏幕逐行扫描算法
- 移除VBA项目密码的VBA代码
- DVB机顶盒工作原理
- VB获取文件大小的方法
- VB.NET获取文件默认图标的方法
- VB中错误处理On Error的应用
- Visual Studio 2013 添加 Visual Basic Power Packs 工具箱
- VB与C#的区别
- cvBoostStartTraining, cvBoostNextWeakClassifier和 cvBoostEndTraining
- vbe6ext.olb 不能被加载
- 怎样用vb设置文件夹权限?解决办法
- windows基于词典自动修改密码(vbs脚本)
- VB调用EXCEL,第二次报错问题
- updat.vbs u盘病毒
- VB.NET使文本框只能输入数字
- 串口调试助手---VB源代码
- vbs操作excel
- 【机房重构】—上机&订餐