VBA实例:Word文档内容搜索器，文件遍历，当前位置下子文件夹遍历(by daode12...

'''Word文档内容搜索器，文件遍历，当前位置下子文件夹遍历
'''输出于Excel/Sheet2中
'''存在的用"***"表示，不存在的用"---"表示。
'''要搜索的字符在openWord中：xStr ="???"中定义。
'''本VBA用于Excel,可粘贴于模块中，再运行宏。
'''------by daode1212 , 2010-10-20

Dim nFile As Integer

Sub 遍历子文件在DOC中搜索字符()
'''DOC搜索主程序入口:
   nFile = 0
   way = ThisWorkbook.path
   getAllFolder CStr(way)
End Sub

Sub getAllFolder(path)
'''遍历文件夹:
Set fso = CreateObject("Scripting.FileSystemObject")
Set objfolder = fso.GetFolder(path)
Set objSubFolders = objfolder.SubFolders
Set objfolder = Nothing
getAllFile path
For Each objSubFolder In objSubFolders
    nowPath = CStr(path & "\" & objSubFolder.Name)
    getAllFolder nowPath
    '''getAllFile nowPath
Next
Set fso = Nothing
End Sub

Sub getAllFile(fold)
'''遍历文件,输出路径与文件名:
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objfiles = fso.GetFolder(fold)
    For Each objfile In objfiles.Files
        nowFile = objfile.Name
        If LCase(Right(nowFile, 4)) = ".doc" Then
          nFile = nFile + 1 '文件个数，写入Sheet2中的行标；
          Sheet2.Cells(nFile, 2) = fold
          Sheet2.Cells(nFile, 3) = nowFile
          curPF = fold & "\" & nowFile
          openWord curPF, nFile
        End If
    Next
    Set objfiles = Nothing
    Set fso = Nothing
End Sub

Sub openWord(curPF, nFile)
'''搜索字符串:
xStr = "防雪防冻"
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = False
    Set wrdDoc = wrdApp.Documents.Open(curPF)
    strText = wrdDoc.Range.Text() '读取全文；
    If InStr(strText, xStr) Then
       Sheet2.Cells(nFile, 1) = "***" '找到的文件；
    Else
       Sheet2.Cells(nFile, 1) = "---" '未找到的文件；
    End If
    wrdDoc.Close
    wrdApp.Quit
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
End Sub

'''课题之一：将本程序修改为文本的替换；
'''课题之二：将本程序修改为特有文本的剥取；