设为首页收藏本站|繁體中文

Excel 技巧网

 找回密码
 注册

QQ登录

只需一步,快速开始

手机号码,快捷登录

查看: 9097|回复: 8

[Excel VBA] 如何遍历文件夹及其子文件夹中的所有Excel文件?

[复制链接]
发表于 2011-7-9 23:10:47 | 显示全部楼层 |阅读模式
  • 署名作者: lrlxxqxa
  • 版权声明: 版权归本站与作者共有 除本站官方外非作者本人转载须经许可并注明出处
  • 本文来自:
  • 引用作品:
  • 适用版本: 2010 2007 2003以前版本 
  • 语言环境: 简体中文
  • 学习方法: 掌握Excel技巧的关键是动手操作 | 下载 ≠ 知识


  • 免费注册成为本站会员,享用更多功能,结识更多Office办公高手!

    您需要 登录 才可以下载或查看,没有帐号?注册

    x
    本帖最后由 lrlxxqxa 于 2011-7-9 23:15 编辑

    Q:如何遍历文件夹及其子文件夹中的所有Excel文件?

    A:
    1. Sub Test()    '使用双字典,旨在提高速度
    2.     Dim MyName, Dic, Did, I, T, F, TT, MyFileName
    3.     Set objShell = CreateObject("Shell.Application")
    4.     Set objFolder = objShell.BrowseForFolder(0, "选择文件夹", 0, 0)
    5.     If Not objFolder Is Nothing Then lj = objFolder.self.Path & ""
    6.     Set objFolder = Nothing
    7.     Set objShell = Nothing
    8.     T = Timer
    9.     Set Dic = CreateObject("Scripting.Dictionary")    '创建一个字典对象
    10.     Set Did = CreateObject("Scripting.Dictionary")
    11.     Dic.Add (lj), ""
    12.     I = 0
    13.     Do While I < Dic.Count
    14.         Ke = Dic.keys   '开始遍历字典
    15.         MyName = Dir(Ke(I), vbDirectory)    '查找目录
    16.         Do While MyName <> ""
    17.             If MyName <> "." And MyName <> ".." Then
    18.                 If (GetAttr(Ke(I) & MyName) And vbDirectory) = vbDirectory Then    '如果是次级目录
    19.                     Dic.Add (Ke(I) & MyName & ""), ""  '就往字典中添加这个次级目录名作为一个条目
    20.                 End If
    21.             End If
    22.             MyName = Dir    '继续遍历寻找
    23.         Loop
    24.         I = I + 1
    25.     Loop
    26.     Did.Add ("文件清单"), ""
    27.     For Each Ke In Dic.keys
    28.         MyFileName = Dir(Ke & "*.xls")
    29.         Do While MyFileName <> ""
    30.             Did.Add (Ke & MyFileName), ""
    31.             MyFileName = Dir
    32.         Loop
    33.     Next
    34.     For Each Sh In ThisWorkbook.Worksheets
    35.         If Sh.Name = "XLS文件清单" Then
    36.             Sheets("XLS文件清单").Cells.Delete
    37.             F = True
    38.             Exit For
    39.         Else
    40.             F = False
    41.         End If
    42.     Next
    43.     If Not F Then
    44.         Sheets.Add.Name = "XLS文件清单"
    45.     End If
    46.     Sheets("XLS文件清单").[A1].Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.keys)
    47.     TT = Timer - T
    48.     MsgBox TT    'Minute(TT) & "分" & Second(TT) & "秒"
    49. End Sub
    复制代码


                                   
    登录/注册后可看大图
    本主题已经同步到 lrlxxqxa的微博

    3.rar

    7.83 KB, 下载次数: 119, 下载积分: 消费券 -5 Ti币

    如何遍历文件夹及其子文件夹中的所有Excel文件?

    发表于 2012-3-8 23:38:45 | 显示全部楼层
    已下载,因没有内容,暂时未领略到作用。试试先。
    回复 支持 反对

    使用道具 举报

    发表于 2013-3-21 08:41:06 | 显示全部楼层
    正在为此事发愁呢,谢谢您!
    回复 支持 反对

    使用道具 举报

    发表于 2013-12-22 16:55:11 | 显示全部楼层
    学习锐版的代码
    回复 支持 反对

    使用道具 举报

    发表于 2014-1-14 15:56:33 | 显示全部楼层
    学习
    回复

    使用道具 举报

    发表于 2014-3-29 13:40:48 | 显示全部楼层
    只需要,谢谢!   
    回复 支持 反对

    使用道具 举报

    发表于 2019-1-29 11:33:59 | 显示全部楼层
    正在为此事发愁呢,谢谢您!
    回复 支持 反对

    使用道具 举报

    发表于 2019-4-24 22:16:05 | 显示全部楼层
    谢谢分享!受教了
    回复 支持 反对

    使用道具 举报

    发表于 2019-4-28 09:23:54 | 显示全部楼层
    再次学习,基本理解了
    回复 支持 反对

    使用道具 举报

    您需要登录后才可以回帖 登录 | 注册

    本版积分规则

    关闭

    站长推荐上一条 /1 下一条

    Excel技巧网的会员探讨问题仅代表其个人意见,与网站的立场无关。任何违反国家和地方相关法律法规的言论,本站有义务协助政府相关部门追究发言者的责任!
    本站中非注明转载文章与案例的版权为作者与Excel技巧网共有。若非原文作者,本站之外任何单位或个人未经允许,不得将其用于商业用途。
    若非原文作者,任何形式的非商业性转载必须获得Excel技巧网或作者允许,并注明作者和出处。
    会员发表的帖子如涉及版权纠纷,须自行负责。详情请参考注册时的网站服务条款。
    本站特聘法律顾问:沈学律师

    Archiver|手机版|Excel技巧网 ( 闽ICP备08107682号-2 ) | 闽公网安备 35020302032608号  

    GMT+8, 2019-8-24 21:37

    Powered by Discuz! X3.4

    © 2001-2017 Comsenz Inc.

    快速回复 返回顶部 返回列表