Word Document Search 1

[ZOR]

I am using this code within access, to search a word document for mathing words typed in Text0.

It only highlights the first found word. Any ideas how I can make it highlight all found words. A real gem would also be to highlight and extract into strings the whole paragraph containing the word searched for. Many thanks.

Set WD = CreateObject(Class:="Word.Application")
WD.Visible = True 'False 'True

'Open the Document
WD.Documents.Open Filename:=LWordDoc, ReadOnly:=True

WD.Selection.Find.ClearFormatting
With WD.Selection.Find
.Text = Me.Text0
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

WD.Selection.Find.Execute

If WD.Selection.Find

 

[PHV]

extract into strings the whole paragraph containing the word searched for
If WD.Selection.Found = True Then
WD.Selection.Parent.Expand Unit:=4 '4=wdParagraph
yourString = WD.Selection.Parent.Text
End If

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[ZOR]

Thanks PHV. I am getting the error
"Object does not support this property or method" on this line

If WD.Selection.Found = True Then

Any ideas, thanks

 

[ZOR]

I changed this:
If WD.Selection.Found = True Then

to this

If WD.Selection.Find.Found Then

It now errors on this line

WD.Selection.Parent.Expand Unit:=4 '4=wdParagraph

?? Thanks

 

[Remou]

This seems to relate to thread702-1447092

 

[ZOR]

Thanks Remou, correct, sorry, maybe I should have continued where left off. I am trying to get the whole paragraph of where the selected/found word is, also any other paragraphs which again contain the searched for word.

Regarding finding all the words that appear, I tried doing a macro in word where I searched for a word, and selected more in the menu to get all occurences of the word, but nothing new of syntax appears in the macro code.
Regards

 

[ZOR]

Thanks PHV.

I changed:
If WD.Selection.Found = True

To:
If WD.Selection.Find.Found

And removed the word Parent
WD.Selection.Expand Unit:=4
and it now produces the paragaph I want with the selected word.

Any idea how I force it to continue through the document to get any further word occurence/paragraphs?

Regards

 

[ZOR]

Thanks all, I got there:

Do While WD.Selection.Find.Found
WD.Selection.Expand Unit:=wdParagraph
strWordData = strWordData & WD.Selection.Range
WD.Selection.Collapse wdCollapseEnd
WD.Selection.Find.Execute
Whatswanted = Whatswanted & Left(strWordData, Len(strWordData))
Loop

Regards

 

[ZOR]

Using the code below works, looping through paragraphs and returning those containing a selected word, however at the end of each paragraph a small box is present. Any idea how I can get rid of it? Thanks

Do While WD.Selection.Find.Found

WD.Selection.Expand Unit:=wdParagraph

strWordData = strWordData & WD.Selection.Range & " -------"

WD.Selection.Collapse wdCollapseEnd

Me.FoundWord = Left(strWordData, Len(strWordData))

WD.Selection.Find.Execute
Loop

 

[PHV]

Do While WD.Selection.Find.Found
WD.Selection.Expand Unit:=wdParagraph
strWordData = WD.Selection.Range
WD.Selection.Collapse wdCollapseEnd
Me!FoundWord = Me!FoundWord & Left(strWordData, Len(strWordData) - 1) & " -------"
WD.Selection.Find.Execute
Loop

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[ZOR]

Thanks PHV, that solved it. Best regards

 

[ZOR]

Can anyone see a way to make this process quicker. Basically two lists boxes get cycled, one containing aa athletes name, the other contains a list of word documents. The idea is the word documents get opened and checked for a match in the Athletes name being mentioned, the name and the document name then gets saved. At present its taking hours and hours, possibly days to run through.

Many thanks

The code
Dim WD As Object, TY As Integer, LWordDocA As String, TY2 As Integer, LWordDocB As String
Dim db As DAO.Database, rsAthlete As DAO.Recordset, rsDocument As DAO.Recordset, rsDump As DAO.Recordset
Dim strsql As String

Set rsDocuments = CurrentDb.OpenRecordset("Documents", dbOpenDynaset)
Set rsDump = CurrentDb.OpenRecordset("Dump", dbOpenDynaset)

For TY2 = 0 To Me.Athletes.ListCount - 1
Me.Athletes.SetFocus
Me.Athletes.ListIndex = TY2
LWordDocB = Me.Athletes.Value

For TY = 0 To Me.DocsList.ListCount - 1
Me.DocsList.SetFocus
Me.DocsList.ListIndex = TY
LWordDocA = Me.DocsList.Value


LWordDoc = "c:\Logging\Football\" & LWordDocA

Set WD = CreateObject(Class:="Word.Application")
WD.Visible = False 'True

'Open the Document
WD.Documents.Open Filename:=LWordDoc, ReadOnly:=True

WD.Selection.Find.ClearFormatting
With WD.Selection.Find
.Text = LWordDocB
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

End With


WD.Selection.Find.Execute


If WD.Selection.Find.Found Then
rsDump.AddNew
rsDump!Athlete = LWordDocB
rsDump!Document = Me.DocsList.Value
rsDump.Update

Else
' Me!FOUNDIT.AddItem "NOT FOUND"
End If
DoEvents

WD.Quit
Me.results.Requery
Next
Next

Set WD = Nothing

 

[ZOR]

I have managed to clean up the code, it runs faster now. Can anyone spot a way to speed it up anymore, it's currently searching 4 documents a second for mathed content. Thanks

Set WD = CreateObject(Class:="Word.Application")
For TY2 = 1 To Me.Athletes.ListCount - 1
LWordDocB = Me.Athletes.ItemData(TY2)
Me.AthName.Caption = LWordDocB
For TY = 0 To Me.DocsList.ListCount - 1
LWordDocA = Me.DocsList.ItemData(TY)
Me.WhereamI.Caption = Me.DocsList.ItemData(TY)
LWordDoc = "c:\Logging\Football\" & LWordDocA

'Open the Document
Set doc = WD.Documents.Open(Filename:=LWordDoc, ReadOnly:=True)
With WD.Selection.Find
.ClearFormatting
.Text = LWordDocB
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
If .Execute Then
rsDump.AddNew
rsDump!Athlete = LWordDocB
rsDump!Document = Me.DocsList.ItemData(TY)
rsDump.Update
Else
' Do nothing for now
End If
End With
doc.Close SaveChanges:=False
DoEvents

Next TY
Next TY2
WD.Quit
Set WD = Nothing


Me.results.Requery