在VBA中搜索文檔中的多個術語？

Question

我正在嘗試創建一個宏，用於Microsoft Word 2007中，該宏將搜索位於外部Excel文件中的多個關鍵字（字符串變量）的文檔（使其在外部文件中的條件是經常被改變和更新）。我已經想出瞭如何逐段搜索一個文檔併爲該詞的每個實例着色，並且我假設正確的方法是使用動態數組作爲搜索詞變量。

問題是：我如何讓宏創建一個包含來自外部文件的所有術語的數組並搜索每個術語的每個段落？

這是我到目前爲止有：

Sub SearchForMultipleTerms() 
' 
Dim SearchTerm As String 'declare search term 
SearchTerm = InputBox("What are you looking for?") 'prompt for term. this should be removed, as the terms should come from an external XLS file rather than user input. 

Selection.Find.ClearFormatting 
Selection.Find.Replacement.ClearFormatti… 
With Selection.Find 
    .Text = SearchTerm 'find the term! 
    .Forward = True 
    .Wrap = wdFindStop 
    .Format = False 
    .MatchCase = False 
    .MatchWholeWord = False 
    .MatchWildcards = False 
    .MatchSoundsLike = False 
    .MatchAllWordForms = False 
End With 
While Selection.Find.Execute 
    Selection.GoTo What:=wdGoToBookmark, Name:="\Para" 'select paragraph 
    Selection.Font.Color = wdColorGray40 'color paragraph 
    Selection.MoveDown Unit:=wdParagraph, Count:=1 'move to next paragraph 
Wend 

End Sub 

爲尋找謝謝！

Answer 1

也許東西在這些線路上：

Dim cn As Object 
Dim rs As Object 
Dim strFile, strCon 

strFile = "C:\Docs\Words.xls" 

'' HDR=Yes, so there are column headings 
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _ 
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";" 

Set cn = CreateObject("ADODB.Connection") 
Set rs = CreateObject("ADODB.Recordset") 

cn.Open strCon 

'' The column heading (field name) is Words 
strSQL = "SELECT Words FROM [Sheet5$]" 
rs.Open strSQL, cn 

Do While Not rs.EOF 
    Selection.Find.ClearFormatting 
    With Selection.Find 
     .Text = rs!Words '' find the term! 
     .Forward = True 
     .Wrap = wdFindContinue 
     .MatchWholeWord = True 
    End With 
    While Selection.Find.Execute 
     Selection.GoTo What:=wdGoToBookmark, Name:="\Para" 'select paragraph 
     Selection.Font.Color = wdColorGray40 'color paragraph 
     Selection.MoveDown Unit:=wdParagraph, Count:=1 'move to next paragraph 
    Wend 

    rs.Movenext 
Loop 

Answer 2

嘿，感謝您的答覆！我對你的方法有點困惑，我不知道ADODB究竟是什麼東西。我實際上最終找出了一種爲我工作的方法。對於任何未來看到這個的人，這裏是：

Sub ThisThing() 
' 

    Dim xlApp As Excel.Application 'defines xlApp to be an Excel application 
    Dim xlWB As Excel.Workbook 'defines xlWB to be an Excel workbook 
    Set xlApp = CreateObject("Excel.Application") 'starts up Excel 
    xlApp.Visible = False 'doesnt show Excel 
    Set xlWB = xlApp.Workbooks.Open("P:\SomeFile.xls") 'opens this Excel file 

    Dim r As Integer 'defines our row counter, r 
    r = 2 'which row to start on 

    End With 

    With xlWB.Worksheets(1) 'working in Worksheet1 
     While xlApp.Cells(r, 1).Formula <> "" 'as long as the cell formula isn't blank 

      Selection.Find.ClearFormatting 
      Selection.Find.Replacement.ClearFormatting 
      With Selection.Find 
      Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1" 'start at beginning of page 
       .Text = xlApp.Cells(r, 1).Formula 'search for the value of cell r 
       .Forward = True 
       .Wrap = wdFindStop 
       .Format = False 
       .MatchCase = False 
       .MatchWholeWord = False 
       .MatchWildcards = False 
       .MatchSoundsLike = False 
       .MatchAllWordForms = False 
       r = r + 1 
      End With 
      While Selection.Find.Execute 
       Selection.GoTo What:=wdGoToBookmark, Name:="\Para" 
       Selection.Font.Color = wdColorGray40 
       Selection.MoveDown Unit:=wdParagraph, Count:=1 
      Wend 'end for the "while find.execute" 
     Wend 'end for the "while cells aren't blank" 
    End With 
    Set wkbBook = Nothing 
    xlApp.Quit 
    Set xlApp = Nothing 
End Sub