I have a table of words in an access db. I want to check word documents
against this list and highlight any words in the doc that match. This
procedure works but it takes way too long. Any suggestions?

Function Boldwords()

Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objRg As Range
Dim strDoc As String
Dim db As Database
Dim rs As Recordset

strDoc = InputBox("Enter the path and file name of document. i.e.
f:\doc.doc")

Set objWord = New Word.Application
Set objDoc = objWord.Documents.Open(strDoc)
Set objRg = objDoc.Range
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblWords", dbOpenDynaset)

rs.MoveFirst
Do While Not rs.EOF
Set objRg = objDoc.Range
With objRg.Find
.Text = " " & rs![Word] & " "
While .Execute
objRg.Font.Bold = wdToggle
Wend
End With
Set objRg = objRg.Document.Range
With objRg.Find
.Text = " " & rs![Word] & "."
While .Execute
objRg.Font.Bold = wdToggle
Wend
End With
rs.MoveNext
Loop

objWord.Documents(strDoc).Close SaveChanges:=wdSaveChanges
objWord.Quit

Set objRg = Nothing
Set objDoc = Nothing
Set objWord = Nothing
Set rs = Nothing
Set db = Nothing

End Function
--
Teach me to fish! Thanks for the help.
Pax, M

Hi,
try to switch off "check proofing as you type" option in word, sometimes it
helps.
If this is a plain text in word - then I suggest to copy it to a string var,
do everything in access, marking bold words as #word#, and then apply
formatting in word in one step

--
Best regards,
___________
Alex Dybenko (MVP)
http://accessblog.net
http://www.PointLtd.com


"m stroup" <(E-Mail Removed)> wrote in message
news:3E883E04-F5E9-47AA-8139-(E-Mail Removed)...
> I have a table of words in an access db. I want to check word documents
> against this list and highlight any words in the doc that match. This
> procedure works but it takes way too long. Any suggestions?
>
> Function Boldwords()
>
> Dim objWord As Word.Application
> Dim objDoc As Word.Document
> Dim objRg As Range
> Dim strDoc As String
> Dim db As Database
> Dim rs As Recordset
>
> strDoc = InputBox("Enter the path and file name of document. i.e.
> f:\doc.doc")
>
> Set objWord = New Word.Application
> Set objDoc = objWord.Documents.Open(strDoc)
> Set objRg = objDoc.Range
> Set db = CurrentDb()
> Set rs = db.OpenRecordset("tblWords", dbOpenDynaset)
>
> rs.MoveFirst
> Do While Not rs.EOF
> Set objRg = objDoc.Range
> With objRg.Find
> .Text = " " & rs![Word] & " "
> While .Execute
> objRg.Font.Bold = wdToggle
> Wend
> End With
> Set objRg = objRg.Document.Range
> With objRg.Find
> .Text = " " & rs![Word] & "."
> While .Execute
> objRg.Font.Bold = wdToggle
> Wend
> End With
> rs.MoveNext
> Loop
>
> objWord.Documents(strDoc).Close SaveChanges:=wdSaveChanges
> objWord.Quit
>
> Set objRg = Nothing
> Set objDoc = Nothing
> Set objWord = Nothing
> Set rs = Nothing
> Set db = Nothing
>
> End Function
> --
> Teach me to fish! Thanks for the help.
> Pax, M