Searching a document for multiple terms in VBA?
I'm trying to create a macro to be used in Microsoft Word 2007 that will search a document for multiple keywords (string variables) located in an external Excel file (the reason for having it in an external file is that the terms will often be changed and updated). I've figured out how to search a document paragraph by paragraph for a single term and color every instance of that term, and I assumed that the proper method would be to use a dynamic array as the search term variable.
The question is: how do I get the macro to create an array containing all the terms from an external file and search each paragraph for each and every term?
This is what I have so far:
Sub Se开发者_如何学CarchForMultipleTerms()
'
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
Thanks for looking!
Perhaps something on these lines:
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
Hey, thanks for the reply! I was a little confused by your method, I don't know what exactly things like ADODB is. I actually ended up figuring out a method that worked for me. For anyone that sees this in the future, here it is:
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
精彩评论