VBA笔记——遍历文件夹(含子文件夹)方法

文章目录

  • 一、调用目标文件夹的方法
    • 1、Application.FileDialog方法
    • 2、视窗浏览器界面选择目标文件夹
  • 二、仅列出所有文件
  • 三、仅列出目标文件夹中所有子文件夹名
  • 四、遍历目标文件夹内所有文件、以及所有子文件夹中的所有文件

一、调用目标文件夹的方法

1、Application.FileDialog方法

Sub ListFilesTest() With Application.FileDialog(msoFileDialogFolderPicker) '运行后出现标准的选择文件夹对话框 If .Show Then myPath = .SelectedItems(1) Else Exit Sub '如选中则返回=-1 / 取消未选则返回=0 End With If Right(myPath, 1) <> '' Then myPath = myPath & '' '返回的是选中目标文件夹的绝对路径,但除了本地C盘、D盘会以'C:'形式返回外，其余路径无''需要自己添加 End Sub

  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7

2、视窗浏览器界面选择目标文件夹

Sub ListFilesTest()
    Set myFolder = CreateObject('Shell.Application').BrowseForFolder(0, 'GetFolder', 0)
    If Not myFolder Is Nothing Then myPath$ = myFolder.Items.Item.Path Else MsgBox 'Folder not Selected': Exit Sub
    If Right(myPath, 1) <> '' Then myPath = myPath & ''
    '同样返回的是选中目标文件夹的绝对路径,但除了本地C盘、D盘会以'C:'形式返回外，其余路径无''需要添加
End Sub
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6

二、仅列出所有文件

  • 不包括 子文件夹、不包括子文件夹中的文件
Sub ListFilesTest() With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub End With If Right(myPath, 1) <> '' Then myPath = myPath & '' '以上选择目标文件夹以得到路径myPath MsgBox ListFiles(myPath) '调用FSO的ListFiles过程返回目标文件夹下的所有文件名 End Sub Function ListFiles(myPath$) Set fso = CreateObject('Scripting.FileSystemObject') '打开FSO脚本、建立FSO对象实例 For Each f In fso.GetFolder(myPath).Files '用FSO方法遍历指定文件夹内所有文件 i = i + 1: s = s & vbCr & f.Name '逐个列出文件名并统计文件个数 i Next ListFiles = i & ' Files:' & s '返回所有文件名的合并字符串 End Function

  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17

三、仅列出目标文件夹中所有子文件夹名

  • 不包括目标文件夹中文件、不包括子文件夹中的文件或子文件夹
Sub ListFilesTest()
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub
    End With
    If Right(myPath, 1) <> '' Then myPath = myPath & ''
    MsgBox ListFolders(myPath)
End Sub

Function ListFolders(myPath$)
   Set fso = CreateObject('Scripting.FileSystemObject')
   For Each f In fso.GetFolder(myPath).SubFolders
      j = j + 1: t = t & vbCr & f.Name
   Next
   ListFolders = j & ' Folders:' & t
End Function
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15

fso.GetFolder(myPath).Files
fso.GetFolder(myPath).SubFolders

四、遍历目标文件夹内所有文件、以及所有子文件夹中的所有文件

  • 递归
Sub ListFilesTest() With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub End With If Right(myPath, 1) <> '' Then myPath = myPath & '' [a:a] = '' '清空A列 Call ListAllFso(myPath) '调用FSO遍历子文件夹的递归过程 End Sub Function ListAllFso(myPath$) '用FSO方法遍历并列出所有文件和文件夹名的【递归过程】 Set fld = CreateObject('Scripting.FileSystemObject').GetFolder(myPath) '用FSO方法得到当前路径的文件夹对象实例 注意这里的【当前路径myPath是个递归变量】 For Each f In fld.Files '遍历当前文件夹内所有【文件.Files】 [a65536].End(3).Offset(1) = f.Name '在A列逐个列出文件名 Next For Each fd In fld.SubFolders '遍历当前文件夹内所有【子文件夹.SubFolders】 [a65536].End(3).Offset(1) = ' ' & fd.Name & '' '在A列逐个列出子文件夹名 Call ListAllFso(fd.Path) '注意此时的路径变量已经改变为【子文件夹的路径fd.Path】 '注意重点在这里： 继续向下调用递归过程【遍历子文件夹内所有文件文件夹对象】 Next End Function

  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 字典
Sub ListFilesTest()
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub
    End With
    If Right(myPath, 1) <> '' Then myPath = myPath & ''

    MsgBox 'List Files:' & vbCr & Join(ListAllFsoDic(myPath), vbCr)
    MsgBox 'List SubFolders:' & vbCr & Join(ListAllFsoDic(myPath, 1), vbCr)
End Sub

Function ListAllFsoDic(myPath$, Optional k = 0) '使用2个字典但无需递归的遍历过程
    Dim i&, j&
    Set d1 = CreateObject('Scripting.Dictionary') '字典d1记录子文件夹的绝对路径名
    Set d2 = CreateObject('Scripting.Dictionary') '字典d2记录文件名 （文件夹和文件分开处理）

    d1(myPath) = ''           '以当前路径myPath作为起始记录，以便开始循环检查

    Set fso = CreateObject('Scripting.FileSystemObject')
    Do While i < d1.Count
    '当字典1文件夹中有未遍历处理的key存在时进行Do循环 直到 i=d1.Count即所有子文件夹都已处理时停止

        kr = d1.Keys '取出文件夹中所有的key即所有子文件夹路径 （注意每次都要更新）
        For Each f In fso.GetFolder(kr(i)).Files '遍历该子文件夹中所有文件 （注意仅从新的kr(i) 开始）
            j = j + 1: d2(j) = f.Name
           '把该子文件夹内的所有文件名作为字典Item项加入字典d2 (为防止文件重名不能用key属性)
        Next

        i = i + 1 '已经处理过的子文件夹数目 i +1 （避免下次产生重复处理）
        For Each fd In fso.GetFolder(kr(i - 1)).SubFolders '遍历该文件夹中所有新的子文件夹
            d1(fd.Path) = ' ' & fd.Name & ''
            '把新的子文件夹路径存入字典d1以便在下一轮循环中处理
        Next
    Loop

    If k Then ListAllFsoDic = d1.Keys Else ListAllFsoDic = d2.Items
    '如果参数=1则列出字典d1中所有子文件夹的路径名 (如使用d1.Items则仅列出子文件夹名称不含路径)
    '如果参数=0则默认列出字典d2中Items即所有文件名
End Function
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 27
  • 28
  • 29
  • 30
  • 31
  • 32
  • 33
  • 34
  • 35
  • 36
  • 37
  • 38
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 27
  • 28
  • 29
  • 30
  • 31
  • 32
  • 33
  • 34
  • 35
  • 36
  • 37
  • 38
  • DIR
Sub ListAllDirDicTest() With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub End With If Right(myPath, 1) <> '' Then myPath = myPath & '' MsgBox Join(ListAllDirDic(myPath), vbCr) 'GetAllSubFolder's File 列出目标文件夹内含子文件夹内所有文件 MsgBox Join(ListAllDirDic(myPath, 1), vbCr) 'GetThisFolder's File 列出目标文件夹内所有文件(不含子文件夹) MsgBox Join(ListAllDirDic(myPath, -1), vbCr) 'GetThisFolder's SubFolder 仅列出目标文件夹内的子文件夹 MsgBox Join(ListAllDirDic(myPath, -2), vbCr) 'GetAllSubFolder 列出目标文件夹内含子文件夹的所有子文件夹 MsgBox Join(ListAllDirDic(myPath, 1, 'tst'), vbCr) 'GetThisFolder's SpecialFile 仅列出文件夹内含关键字文件 MsgBox Join(ListAllDirDic(myPath, , 'tst'), vbCr) 'GetAllSubFolder's SpecialFile 列出子文件夹内含关键字文件 End Sub Function ListAllDirDic(myPath$, Optional sb& = 0, Optional SpFile$ = '') '利用Dir方法、以及用2个字典分别记录子文件夹路径和文件名的文件搜寻方法。 '第1参数【指定路径myPath】必选 为指定目标文件夹的绝对路径 '第2参数【子文件夹模式sb】为可选 =奇数时只搜寻当前文件夹、=偶数时搜寻所有子文件夹 ' 该参数>=0时返回文件名、<0时返回文件夹路径名 '因此事实上第2参数可以设置这样四种模式： ' 默认=0时，搜寻所有子文件夹并返回所有文件名 ' =1时，搜寻当前文件夹并返回所有文件名 (不向下搜寻子文件夹) ' =-1时，搜寻当前文件夹并返回子文件夹路径名 ' =-2时， 搜寻所有子文件夹并返回所有子文件夹路径名 '第3参数【文件名指定特殊匹配字符SpFile】 可选，返回文件名时用此关键词过滤一下 '默认留空时，返回全部文件名 （等于没有被过滤掉） ' = 某个关键字时，返回符合匹配（即含该关键字）的部分文件名 （有过滤掉不含关键字的文件名） ' = .xl 也可这样指定文件类型，返回匹配（该关键字指定文件类型）的部分文件名 （过滤掉其它类型文件名） Dim i&, j&, myFile$ Set d1 = CreateObject('Scripting.Dictionary') '定义存放子文件夹路径的字典d1 Set d2 = CreateObject('Scripting.Dictionary') '定义存放文件名的字典d2 d1(myPath) = ' '字典d1初始化记录目标文件夹路径名 On Error Resume Next Do While i < d1.Count kr = d1.Keys '从字典d1中更新提取所有子文件夹 myFile = Dir(kr(i), vbDirectory) '用Dir方法遍历该子文件夹得到文件或文件夹名 注意从kr(i)开始避免重复 Do While myFile <> '' 'Dir遍历直到返回空字符串 （即无未被遍历的文件或文件夹了） If myFile <> '.' And myFile <> '..' Then '如果是'.'或'..'属性则不用处理 If (GetAttr(kr(i) & myFile) And vbDirectory) = vbDirectory Then '判断是文件夹属性时 If Err.Number Then Err.Clear Else d1(kr(i) & myFile & '') = '' '#52 文件名Err时忽略（一般为操作系统语言文字环境问题），否则字典d1记录该子文件夹路径 Else '如果不是文件夹则为文件 If SpFile = '' Then '如未指定关键字 j = j +1: d2(j) = myFile '则所有文件名都作为Item项加入字典d2 (不能使用key防止重名文件) Else '否则指定了关键字 If InStr(myFile, SpFile) Then j = j +1: d2(j) = myFile '则判断含有指定关键字以后才可作为Item项加入字典d2 (不能使用key防止重名文件) End If End If End If myFile = Dir '用Dir方法继续搜寻下一个文件或子文件夹 Loop If sb Mod 2 Then Exit Do Else i = i + 1 '如果第2参数指定为奇数则不用继续检查子文件夹就可退出， '否则 i+1避免重复检查然后利用字典d1中的记录，继续检查下一个子文件夹直到全部子文件夹检查完毕 Loop If sb >= 0 Or Len(SpFile) Then ListAllDirDic = d2.Items Else ListAllDirDic = d1.Keys '如果第2参数>=0或第3参数有指定则返回d2的Items文件名、否则返回d1的keys子文件夹名 End Function

  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 27
  • 28
  • 29
  • 30
  • 31
  • 32
  • 33
  • 34
  • 35
  • 36
  • 37
  • 38
  • 39
  • 40
  • 41
  • 42
  • 43
  • 44
  • 45
  • 46
  • 47
  • 48
  • 49
  • 50
  • 51
  • 52
  • 53
  • 54
  • 55
  • 56
  • 57
  • 58
  • 59
  • 60
  • 61
  • 62
  • 63
  • 64
  • 65
  • 66
  • 67
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 27
  • 28
  • 29
  • 30
  • 31
  • 32
  • 33
  • 34
  • 35
  • 36
  • 37
  • 38
  • 39
  • 40
  • 41
  • 42
  • 43
  • 44
  • 45
  • 46
  • 47
  • 48
  • 49
  • 50
  • 51
  • 52
  • 53
  • 54
  • 55
  • 56
  • 57
  • 58
  • 59
  • 60
  • 61
  • 62
  • 63
  • 64
  • 65
  • 66
  • 67
  • Redim Preserve
  • 调用Dos中的Dir命令
Sub ListFilesDos()
    Set myFolder = CreateObject('Shell.Application').BrowseForFolder(0, 'GetFolder', 0)
    If Not myFolder Is Nothing Then myPath$ = myFolder.Items.Item.Path Else MsgBox 'Folder not Selected': Exit Sub

    myFile$ = InputBox('Filename', 'Find File', '.xl')
    '在这里输入需要指定的关键字，可以是文件名的一部分，或指定文件类型如 '.xl'
    tms = Timer
    With CreateObject('Wscript.Shell') 'VBA调用Dos命令
        ar = Split(.exec('cmd /c dir /a-d /b /s ' & Chr(34) & myPath & Chr(34)).StdOut.ReadAll, vbCrLf) '所有文档含子文件夹
        '指定Dos中Dir命令的开关然后提取结果 为指定文件夹以及所含子文件夹内的所有文件的含路径全名。
        s = 'from ' & UBound(ar) & ' Files by Search time: ' & Format(Timer - tms, ' 0.00s') & ' in: ' & myPath
        '记录Dos中执行Dir命令的耗时
        tms = Timer: ar = Filter(ar, myFile) '然后开始按指定关键词进行筛选。可筛选文件名或文件类型
        Application.StatusBar = Format(Timer - tms, '0.00s') & ' Find ' & UBound(ar) + IIf(myFile = '', 0, 1) & ' Files ' & s
        '在Excel状态栏上显示执行结果以及耗时
    End With
    [a:a] = '': If UBound(ar) > -1 Then [a2].Resize(1 + UBound(ar)) = WorksheetFunction.Transpose(ar)
    '清空A列，然后输出结果
End Sub
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19

来源：遍历文件夹(含子文件夹)方法

赞 (0)

相关推荐