VBA에서 여러 용어에 대한 문서 검색 중?

Question

외부 Excel 파일에있는 여러 키워드 (문자열 변수)에 대한 문서를 검색 할 Microsoft Word 2007에서 사용할 매크로를 만들려고합니다. 외부 파일에있는 이유는 용어가 종종 변경되고 업데이트 됨). 한 단락에 대해 단락으로 문서 단락을 검색하고 해당 용어의 모든 인스턴스를 색칠하는 방법을 알아 냈습니다. 적절한 방법은 동적 배열을 검색 용어 변수로 사용하는 것이라고 가정했습니다.

질문 : 매크로를 사용하여 외부 파일의 모든 용어를 포함하는 배열을 만들고 각각의 단락마다 각각의 단락을 검색하려면 어떻게해야합니까?

이것은 내가 지금까지 무엇을 가지고 :보고에 대한

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