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