请各位大神编写一个VBA程序 能在指定文件夹下包括子文件夹内查找包含关键字的文件谢谢

dzfshr

请各位大神编写一个VBA程序 能在指定文件夹下包括子文件夹内查找包含关键字的文件谢谢

limonet

everything

GG函数

Enocheasty

这不是Explorer的事吗？打开所在目录，右上角搜索即可，

opiona

https://club.excelhome.net/thread-1409141-1-1.html

lushang2018

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

复制代码

martn

查找包含关键字的文件名 有很多很好的软件呀  比如光速搜索 ，至于查找包含关键字 文件内容也有很多成熟的软件 没必要VBA

ykcbf1100

上传一个附件，能很快解决。

baofa2

Sub Main()
  Dim i As Long, iCount As Long
  Dim strPath As String, objFso As Object, vrtFiles(1 To 2345) As String
  Set objFso = CreateObject("Scripting.FileSystemObject")
  strPath = ThisWorkbook.Path               '这里指定文件夹 如  C:\123\456\789\abc
  GetFiles strPath, objFso, vrtFiles, iCount, "$", "*关键字*.xls*"
  Set objFso = Nothing
  For i = 1 To iCount
    Debug.Print vrtFiles(i)
    '遍历符合的文件
  Next
End Sub

Function GetFiles(strPath As String, objFso As Object, vrtFiles() As String, iCount As Long, strExclude As String, Optional strFilter As String = ".xls")
  Dim objSubFolder As Object, objFilterFile As Object
  For Each objFilterFile In objFso.GetFolder(strPath).Files
    If objFilterFile.Name Like strFilter Then
      If InStr(objFilterFile.Name, strExclude) = 0 Then
        iCount = iCount + 1
        vrtFiles(iCount) = objFilterFile.Path
      End If
    End If
  Next
  For Each objSubFolder In objFso.GetFolder(strPath).SubFolders
    GetFiles objSubFolder.Path, objFso, vrtFiles, iCount, strExclude, strFilter
  Next
End Function

gwjkkkkk

everything我觉得还是最优选择，速度最快。。。