循环遍历文件夹--文件搜索（宏）实用版 v1

413191246se · 发表于 2015-8-18 00:56

本帖最后由 413191246se 于 2015-8-18 13:38 编辑

* 原因：Word2003本身的《文件搜索》功能不能查找到文件！WIN7系统也无法找到关键词文件，网络上搜索软件试用好几个也无法查找到文件，偶然看到一个网页谈到 .TextOrProperty属性可以查找正文关键词来返回文件，验证OK！看来只能靠 VBA 了！（其实以前也知道这条语句，但没重视。）
* 功能：在指定文件夹中，通过按《文件名关键词》/《正文关键词》/《文件名关键词 + 正文关键词》三个模式搜索 Word 文档（*.doc）。
* 当找到的文件数少于 22 个时，自动打开所有找到的文件（大家可以自行修改这个值）；否则，询问是否打开。自动提取文件名到空白文档中。
* 注意事项：在运行此宏期间，请耐心等待，不要做各种键盘和鼠标运行，以免程序中途停止。如果不想等待，可以按 Ctrl + PauseBreak 中止程序。
*《循环遍历文件夹_文件搜索》宏（实用版）v1代码：

Sub 循环遍历文件夹_文件搜索()
On Error Resume Next
Dim fd As FileDialog, i As Long, doc As Document, p As String, j As String, k As Long, q As String, r As String, s As String, t As String, a As String
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then p = fd.SelectedItems(1) Else Exit Sub
Set fd = Nothing
If MsgBox("是否搜索文件夹 " & p & " ?", vbYesNo + vbExclamation, "循环遍历文件夹_文件搜索") = vbNo Then Exit Sub
j = MsgBox("是：<文件名关键词> 否：<正文关键词> 取消：<文件名关键词+正文关键词>", vbYesNoCancel + vbExclamation, "请选择文件搜索模式！")
If j = vbYes Then
k = 1: q = "<文件名关键词>": r = "任职"
ElseIf j = vbNo Then
k = 2: q = "<正文关键词>": r = "秦楚楚"
Else
k = 3: q = "<文件名关键词+正文关键词>": r = "任职，秦楚楚"
End If
reipt:
a = InputBox("如果同时输入<文件名关键词>+<正文关键词>，必须以中文逗号分隔！如：“任职，秦楚楚”", "请输入" & q & "搜索文件！", r)
If a = "" Then Exit Sub
If k = 1 Then
If a Like "*，*" Then GoTo reipt
s = a
ElseIf k = 2 Then
If a Like "*，*" Then GoTo reipt
t = a
ElseIf k = 3 Then
If Not (a Like "*，*") Then GoTo reipt
s = Left(a, InStr(a, "，") - 1): t = Mid(a, InStr(a, "，") + 1)
End If
Set doc = Documents.Add
With Application.FileSearch
.NewSearch
.LookIn = p
.SearchSubFolders = True
If k = 1 Then
.FileName = "*" & s & "*.doc"
ElseIf k = 2 Then
.FileName = "*.doc"
.TextOrProperty = t
ElseIf k = 3 Then
.FileName = "*" & s & "*.doc"
.TextOrProperty = t
End If
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
doc.Content.InsertAfter Text:=.FoundFiles(i) & vbCr
Next i
If .FoundFiles.Count >= 22 Then If MsgBox("搜索完毕！共发现 " & .FoundFiles.Count & " 个文件！——是否打开搜索的文件？", vbYesNo + vbExclamation, "循环遍历文件夹_文件搜索") = vbNo Then End
For i = 1 To .FoundFiles.Count
Documents.Open FileName:=.FoundFiles(i)
Next i
MsgBox "搜索完毕！共发现 " & .FoundFiles.Count & " 个文件！", vbOKOnly + vbExclamation, "循环遍历文件夹_文件搜索"
Else
MsgBox "未发现文件！", vbOKOnly + vbCritical, "循环遍历文件夹_文件搜索"
End If
End With
End Sub

复制代码

413191246se · 发表于 2015-8-18 06:45

本帖最后由 413191246se 于 2015-8-18 07:01 编辑

* 补充说明：大家看第8/9 两句代码！
*

.FileName = "*任职*.doc"
.TextOrProperty = "秦楚楚"

.FileName=这句，在指定文件夹内，可以搜索[文件名包含关键词“任职”]的 Word 文件；
.TextOrProperty=这句，在指定文件夹内，可以搜索[文件正文包含关键词“秦楚楚”]的 Word 文件（当不记得文件名是什么的时候，此句代码太有用了！）
而且更好的是：搜索文件是不用打开文件的，与转换文件不同。
* 单独通过搜索[文件名包含的关键词]找到文件，或单独通过搜索[文件正文包含的关键词]找到文件均可，但也可以同时搜索[文件名包含的关键词+正文包含的关键词]找到文件。——找到文件后，一个是把所有找到的文件名列表在空白文档中（未保存，如需保存请自行保存），另一个是打开所有找到的文件。

Sub test()
'查找文件夹中包含关键字的 Word 文档！------成功！！！

'本示例可实现的功能为：返回所有在文件正文或文件属性中包含单词“run”、“running”、“runs”或“ran”的文件。

'TextOrProperty 属性设置需匹配的单词，并将查找范围限制在文件正文或文件属性中。

'MatchTextExactly 属性--'如果仅查找这样的文件，其文件正文中或文件属性中包括指定单词或短语的完全匹配形式，则返回True。Boolean类型，可读写。

'Execute 方法--'开始对指定文件的搜索。返回一个Long类型，如果没有找到文件，则返回零(0)，如果找到一个或多个文件，则返回一个正数。

'LookIn 属性--返回或设置在指定的文件搜索过程中要搜索的文件夹。String类型，可读写。

'FoundFiles 属性--返回一个FoundFiles对象，该对象包括一次查找操作中找到的所有文件的文件名。

Dim i As Long, doc As Document
Set doc = Documents.Add

With Application.FileSearch
      .NewSearch
'       .LookIn = "C:\My Documents"
      .LookIn = "C:\My Work Documents\"

      .SearchSubFolders = True
      .FileName = "*任职*.doc"
'       .TextOrProperty = "run*"
'       .TextOrProperty = ""

'       .MatchTextExactly = True
'       .MatchAllWordForms = True
      .FileType = msoFileTypeAllFiles
      If .Execute > 0 Then
'          Set doc = Documents.Open(FileName:=.FoundFiles(i))
         MsgBox "There were " & .FoundFiles.Count & " file(s) found."
'          For i = 1 To .FoundFiles.Count
'             MsgBox .FoundFiles(i)'逐个显示查找到的文件名
'          Next i

         For i = 1 To .FoundFiles.Count
            doc.Content.InsertAfter Text:=.FoundFiles(i) & vbCr '提取文件名（到空白文档中）
            Documents.Open FileName:=.FoundFiles(i) '打开查找到的文件
         Next i

      Else
         MsgBox "There were no files found."
      End If
End With

End Sub

413191246se · 发表于 2015-8-18 07:02

顶以更新！！！

香川群子 · 发表于 2015-8-18 12:02

413191246se 发表于 2015-8-18 07:02
顶以更新！！！

FileSearch 功能只能在2003以下版本使用。

按目前的现状、80%以上的用户已经是2007以上版本，楼主代码无法使用。

413191246se · 发表于 2015-8-18 13:48

本帖最后由 413191246se 于 2015-8-18 13:52 编辑

谢谢香川群子朋友关注！
据说，VBA 搜索文件可以有四种方法呢！在 2007 版以上可以用其它方法达到目的，我单位现在还是 XP/Office2003，所以我也就随大流了，2007也略有所知，曾经安装过，但还是与大家所用软件保持一致才好。
其实也是没办法的事，前面帖子说了，工作中有时是要查找文件的，但用别的办法找不到，现在用 VBA 看来是找得到的，算是解决了问题。我编程水平不高，但能达到目的即可，效率/算法什么的倒还是其次。
——前几天，跟论坛高人 loquat 兄学会了 InStr()函数的用法，现在喜欢用它，还要应用到《第一章/条》宏上。
——我发现：此宏并不需要打开文档，只在后台内存中运行，这个和文档转换/打印/合并完全不同。有时不记得文件名了，只记得文件中有某个关键词，这样，用此宏就好了。

loquat · 发表于 2015-8-19 08:11

效率的话，应该dir比较高一些最快的事直接调用㎝d

413191246se · 发表于 2015-8-19 13:20

谢谢 loquat！但关键是不会，目前只会此方法一种，而且管用。

13907933959 · 发表于 2015-8-20 16:25

师傅好！
我把你这个宏代码粘贴到代码窗口内，这一行代码变为了红色 a = InputBox("如果同时输入<文件名关键词>+<正文关键词>，必须以中文逗号分隔！如：“任职，秦楚楚”", "请输入" & q & "搜索文件！", r)

再比如我只记得在一个文件夹中，有一篇文档的正文内有：“花狗” 2个字，其它的都不记得，在下面的3行代码中分别怎样填？才可以找到这个文件？

k = 1: q = "<文件名关键词>": r = "任职"
ElseIf j = vbNo Then
k = 2: q = "<正文关键词>": r = "秦楚楚"
Else
k = 3: q = "<文件名关键词+正文关键词>": r = "任职，秦楚楚"
End If
reipt:

413191246se · 发表于 2015-8-20 18:18

本帖最后由 413191246se 于 2015-8-20 18:22 编辑

139：粘贴不正确！不填！
须知，任何过程都是以"Sub XXXX......End Sub"为标志的一段小程序，在这两行代码中间的为真正的程序代码，知道这个原则就好了，你试试重新粘贴。
另外，第二个问题，我的代码已经设置好了，不须用户在代码中修改，只须粘贴在另一个过程的 End Sub 行的后面即可。——你只要把第一个问题解决，第二个问题会迎刃而解。
***你的”把文字排成自左往右的纵向例文"，我试试，看能否用宏实现，你暂时先不要安装下载2010版本，因为那个版本很大，并且安装后，一般2003就不保了。。。

413191246se · 发表于 2015-8-21 09:45

139：”把文字排成自左往右的纵向例文"我用宏试了，看着像从左往右，但后续排版不被支持，所以，你师傅真的需要这种竖排从左往右排版的文字吗？默认的从右向左不行吗？如果非要这种效果，我看来是爱莫能助啊！但我不建议你安装2010版本。（另外这种竖排文字看着也费劲，哪如横排好看。）

		自动登录	找回密码
密码			免费注册

[分享] 循环遍历文件夹--文件搜索（宏）实用版 v1