Поиск документа для нескольких терминов в 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