[求助]关于查找指定内容（百思不得解）

gao2ming1

上次我提问过这个问题，守版帮我过

1.我想能对某个文件夹下的文档和子文件夹内的文档查找，就像windows自带的文件查找，只不过我想的是查找文档内的内容

2.由于查找过程较慢，如果找到一个后想认为的终止查找，除了按快捷键外能否用代码来终止，比如查找时出现一个对话框“正在查找中……，请稍等，若要停止查找请按“取消”按钮”，然后按“取消”按钮，就可终止查找

下面是上次守版给的代码，再次感谢！

QUOTE:

以下是引用gao2ming1在2008-3-19 18:09:56的发言：

谢谢守柔斑竹帮忙，我下载了“多文件多条件批量替换”的文档，功能相当有用，正学习。

不过我想实现的功能是：比如我在某个文件夹中存放了大量word文档，每个文档中又放有大量试题

我想查找是否有内容包含“用人工方法合成同位素”这样一个试题，如果有就打开该文档、光标定位到该位置（或改变这段文字的颜色）。

主要是为了出卷时查找方便。

当然这个功能有点像“题库”功能，但做题库录题太麻烦了。

请参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2008-3-19 18:25:06
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0364^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub Example()
    Dim MyDialog As FileDialog, oDoc As Variant, myDoc As Document
    Dim myFindText As String
    Dim myRange As Range
    On Error Resume Next    '忽略错误
    myFindText = VBA.InputBox("请输入需要查找的关键字", , "用人工方法合成同位素")
    If Len(myFindText) = 0 Then Exit Sub
    '定义一个文件夹选取对话框
    Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
    With MyDialog
        .Filters.Clear    '清除所有文件筛选器中的项目
        .Filters.Add "所有 WORD 文件", "*.doc", 1    '增加筛选器的项目为所有WORD文件
        .AllowMultiSelect = True    '允许多项选择
        If .Show <> -1 Then Exit Sub
        For Each oDoc In .SelectedItems    '在所有选取项目中循环
            '以藏方式打开Word文档
            Set myDoc = Word.Documents.Open(FileName:=oDoc, Visible:=False)
            Set myRange = myDoc.Content
            With myRange.Find
                .Text = myFindText
                .MatchWildcards = False
                If .Execute = True Then
                    myRange.Select
                    myDoc.ActiveWindow.Visible = True
                Else
                    myDoc.Close False
                End If
            End With
        Next
    End With
End Sub

守柔

请认真阅读代码注释内容。

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2008-4-9 19:12:21
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0390^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Sub mySeach()
'搜索指定文档正文内容或者文件属性中包含关键字的Word文档
'在默认情况下,程序将一一打开这些文件,除非用户在打开对话框中选择的打开
'时,程序将退出运行!!请注意是按打开时退出,而非取消时退出
'如果用户没有响应打开对话框(默认是3秒)后程序继续执行
    Dim FS As FileSearch, myFindText As String
    Dim myFolder As String, myDialog As FileDialog
    Dim i As Long, N As Long, myFileName As String
    Dim myDoc As Document, DigOpen As Dialog
    On Error Resume Next
    myFindText = VBA.InputBox("请输入需要查找的关键字", , "用人工方法合成同位素")
    If myFindText = "" Then Exit Sub
    Set myDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With myDialog
        .Title = "请选择一个您需要搜索的文件夹"
        If .Show <> -1 Then Exit Sub
        myFolder = .InitialFileName
    End With
    Set myDialog = Nothing
    Set FS = Application.FileSearch
    With FS
        .NewSearch
        .LookIn = myFolder
        .SearchSubFolders = True
        .FileName = "*.doc"
        .TextOrProperty = myFindText
        If .Execute() > 0 Then
            N = .FoundFiles.Count
            MsgBox "在接下来出来的打开对话框中,如果您按下打开键,程序将退出运行,反之(默认或者无操作)则继续!", vbExclamation, "ExcelHome"
            For i = 1 To N
                myFileName = CStr(.FoundFiles(i))
                Application.StatusBar = i & "/" & N
                Set DigOpen = Word.Dialogs(wdDialogFileOpen)
                With DigOpen
                    .Name = myFileName
                    If .Show(TimeOut:=3000) <> 0 Then ActiveDocument.Close: Exit Sub
                End With
                Set myDoc = Word.Documents.Open(FileName:=myFileName, Visible:=True)
                With myDoc.ActiveWindow.Selection.Find
                    .Text = myFindText
                    .MatchWildcards = False
                    If .Execute = False Then myDoc.Close
                End With
            Next i
            MsgBox "程序已经运行结束！", vbInformation, "ExcelHome"
        Else
            MsgBox "Microsoft Word在" & myFolder & "文件夹中没有找到包含" & myFindText & "关键字的Word文档!", vbInformation, "ExcelHome"
        End If
    End With
End Sub
'----------------------
请测试！

[此贴子已经被作者于2008-4-9 19:12:47编辑过]