Find text in a word document
Thanks for the prompt reply. After spending several days with the
KnowledgeBase, Excel and Word books it turns out that this is not a simple
question. When trying to execute a "find" in the word document from an Excel
Macro, the find did not execute and the returned "Find" results was always
blank. After conversing with the experts in the "Word Programming" forum,
their answer was to copy the text I whish to searh for into a seperate text
or word document and perform the "Find" using a Macro written for "Word".
This seemed to labor intensive for the function I wished to perform so I came
up with a third alternative which is to use a function written for the word
document and call the word function from excel. the code I use seems to work
so I thought I'd put it in here in case anyone would like to use it or
scrutinize it for a more elegant approach.
Here is the Excel Macro....
##########################################
Sub SearchForText()
'
' SearchForText Macro
'
'
Dim WordApp As Word.Application
Dim wordDoc As Document
Dim WordWasNotRunning As Boolean
Dim inRange As Range
Dim srcCell As Range
Dim srchResults As String
Dim srchStr As String
Dim tmp As Variant
WordWasNotRunning = False
'Get existing instance of Word if it's open; otherwise create a new one
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err Then
Set WordApp = New Word.Application
WordWasNotRunning = True
End If
On Error GoTo Err_Handler
WordApp.Visible = True
WordApp.Activate
WordApp.Application.ScreenUpdating = False
Set wordDoc = WordApp.Documents.Open("C:\MyPath\MyDoc.docx",
ReadOnly:=True)
On Error Resume Next
Set inRange = Worksheets(ActiveSheet.Name).Range("C2:C376")
inRange.Cells.Offset(0, 7).Value = ""
inRange.Cells.Offset(0, 7).Interior.ColorIndex = xlNone
For Each srcCell In inRange.Cells
srchResults = WordApp.Run("TextInstanceFind", srcCell.Text)
If srchResults = "" Then
srcCell.Offset(0, 7).Interior.Color = RGB(149, 55, 53)
Else
srcCell.Offset(0, 7).Value = srchResults
End If
Next srcCell
'Close the document
wordDoc.Close savechanges:=wdDoNotSaveChanges
If WordWasNotRunning Then
'Close Word
WordApp.Quit
End If
Set wordDoc = Nothing
Set WordApp = Nothing
Exit Sub
Err_Handler:
MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error:
" & Err.Number
If WordWasNotRunning Then
WordApp.Quit
End If
End Sub
And here is the Word Function....
##########################################
Function TextInstanceFind(srchStr As String) As String
'
' TextInstanceFindFunction
'
'
Dim foundStr As String
Selection.Start = 1
Selection.End = Selection.Start
Selection.Find.ClearFormatting
With Selection.Find
.Text = srchStr
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
While Selection.Find.Execute = True
' Move to the previous section to find out if the requirement in in a
' requirement list or in a procedure
Selection.MoveLeft
Selection.MoveLeft Unit:=wdCell, Count:=1
If Selection.Text = "Text that indicates that this selection should
be skipped" Then
'This is the wrong selection go to the next
Selection.MoveLeft
Selection.MoveRight Unit:=wdCell, Count:=1
If Selection.End Then
Selection.Start = Selection.End
End If
Else
'This is the correct selection. Go find the heading before
Selection.MoveLeft
Selection.Find.Text = ""
Selection.Find.Style = "Heading 5"
Selection.Find.Forward = False
Selection.Find.Execute
If foundStr = "" Then
foundStr = Selection.Range.ListFormat.ListString
Else
foundStr = foundStr + ", " +
Selection.Range.ListFormat.ListString
End If
' Get the heading number
Selection.Start = Selection.End
Selection.Find.Forward = True
If Selection.Find.Execute = False Then
Selection.Start = Selection.End
Selection.Find.Text = srchStr
Selection.Find.Style = "Normal"
Selection.Find.Forward = True
Selection.Find.Execute
Selection.Start = Selection.End
Else
Selection.MoveLeft
Selection.Find.Text = srchStr
Selection.Find.Style = "Normal"
Selection.Find.Forward = True
End If
End If
'No go to the end of the section and set up the next search
Wend
TextInstanceFind = foundStr
End Function
#######################################
The performance isn't great but it sure saves a lot of cut and paste. If
there is a way to enhance this, please let me know.
--
DR Bellavance
"Joel" wrote:
Here is the excel portion of the code.
Sub GetParagraphs()
Set WordList = Sheets("Sheet1").Range("A1:A100")
Set ParagraphTitle = Sheets("Sheet2")
filetoOpen = Application _
.GetOpenFilename("Word Files (*.doc), *.doc")
If filetoOpen = False Then
MsgBox ("Cannot Open File - Exiting Macro")
Exit Sub
End If
Set WordObj = GetObject(pathname:=filetoOpen)
WordObj.Application.Visible = True
ParRowCount = 1
For Each Word In WordList
'Enter Word Search code here
'ParTitle = "text found in word"
ParagraphTitle.Range("A" & ParRowCount) = ParTitle
ParRowCount = ParRowCount + 1
Next Word
WordObj.Application.Quit
End Sub
"DR Bellavance" wrote:
Thanks for the reply Joel. I was afraid you were going to say that but I
didn't want to post to the "Word" discussion group until the "Excel" group
had a shot at it. I am posting this query to the "Word" group under the same
heading should anyone be interested in the response.
--
DR Bellavance
"Joel" wrote:
Go to the Word Macro webpage. Moving around in the wrod document isn't
simple and it would be better to get help with the word experts.. you c an
still running the macro in excel. You need to create a wordobject in excel
using either GetObject or or Createobject and then open the word document
set Wordobj = GetObject(filename:="c:\temp\word.doc") ' put this in excel
Then reference the macro that you get from the word experts using WordObj in
front of the word macro commands.
"DR Bellavance" wrote:
I have an Excel workbook with a range of cells that contain some text. I
need to find all instances of the text in a seperate Word document then, in
an adjacent cell on the Excel workbook, paste all the paragraph headers where
the text was found in the word document. Can anyone give me a clue??? I am
using Excel 2007 on a Windows XP Pro system.
--
DR Bellavance
|