引言

在日常办公中常常需要用到office的软件，比如word，excel， outlook等，为了使工作自动化，免不了写一些vba宏命令来提高效率。这次来分享一下如何遍历文件夹和文件。

主要使用

• Dictionary对象

  Dictionary对象类似于二维数组，把键和相关条目的数据存放在一起。

  '创建一个Dictionary对象
  Set DicList = CreateObject("Scripting.Dictionary")
  
  'Add(key,item)增加键/条目对到Dictionary
  DicList.Add “MyKey”, “MyItem”
  
  '是否存在指定的键，是返回True，否则返回False
  existflag = DicList.Exists(“MyKey”)
  
  '删除一个指定的键/条目对
  strItem = DicList.Remove(“MyKey”)
  
  '删除全部键/条目对
  DicList.RemoveAll
  
  'Items()返回一个包含Dictionary对象中所有条目的数组
  itemall = DicList.Items
  
  'Keys()返回一个包含Dictionary对象中所有键的数组
  keysall = DicList.Keys
  

• Dir函数

  返回一个 String，用以表示一个文件名、目录名或文件夹名称。

  语法

  Dir[(pathname[, attributes])]

  参数pathname用来指定文件名的字符串表达式，可能为文件夹或文件路径，而且支持模糊输入。

  e.g.：

  • pathname为"E:\test"，则为指定文件夹下的所有文件。
  • pathname为"E:\test*.txt"，则为指定文件夹下的txt结尾的所有文件。

  参数attributes用来指定文件属性，为可选参数。可填入如下常数：

  常数	值	描述
  vbNormal	0	(缺省) 指定没有属性的文件。
  vbReadOnly	1	指定无属性的只读文件
  vbHidden	2	指定无属性的隐藏文件
  VbSystem	4	指定无属性的系统文件 在Macintosh中不可用。
  vbVolume	8	指定卷标文件；如果指定了其它属性，则忽略vbVolume 在Macintosh中不可用。
  vbDirectory	16	指定无属性文件及其路径和文件夹。
  vbAlias	64	指定的文件名是别名，只在Macintosh上可用。

  简单例子

  '找寻第一项
  MyName = Dir("E:\test\") 
  ' 开始循环
  Do While MyName <> ""    
      MsgBox MyName '弹出框显示寻找到的文件名字
      MyName = Dir    ' 查找下一个目录。
  Loop
  

  ​

完整代码

功能：注意弹出E:\test下的所有文件的名称的对话框

Function traverseFolder()
    Const SearchPath = "E:\test\"
      
    Dim DicList, FileList, I, FileName, FilePath
    Set DicList = CreateObject("Scripting.Dictionary")
    Set FileList = CreateObject("Scripting.Dictionary")
      
    DicList.Add SearchPath, ""  '初始化目录
      
    '遍历所有目录并添加到DicList
    I = 0
    Do While I < DicList.Count
        Key = DicList.Keys '本次要遍历的目录
        NowDic = Dir(Key(I), vbDirectory) '开始查找
        Do While NowDic <> ""
            If (NowDic <> ".") And (NowDic <> "..") Then
                If (GetAttr(Key(I) & NowDic) And vbDirectory) = vbDirectory Then 
                    '找到子目录，则添加
                    DicList.Add Key(I) & NowDic & "\", ""
                End If
            End If
            NowDic = Dir() '再找
        Loop
        I = I + 1
    Loop

    '遍历目录中的所有文件并将其添加到FileList中，FileList.Key=文件名,FileList.Item=目录
    For Each Key In DicList.Keys '查找所有目录中的文件
        'MsgBox key
       NowFile = Dir(Key)
       Do While NowFile <> ""
            'MsgBox NowFile
            FileList.Add NowFile, Key 'Add(Key,Item)  FileList.Key=文件名,FileList.Item=目录
            NowFile = Dir()
       Loop
    Next
    
    I = 0
    FileName = FileList.Keys
    FilePath = FileList.Items
    Do While I < FileList.Count
        '弹出所有查询到的文件字符串
        MsgBox FilePath(I) & FileName(I)
        I = I + 1
    Loop
    
End Function

注意

当所选文件夹或子文件夹中存在相同的文件名时，会报错

vba遍历报错.png

解决办法：可以对文件名称进行处理然后再添加到Dictionary对象中。