Search Word doc and record page number

[Gabe Knuth]

Hi all,

I've tried a few ways to do this (which are gone now, otherwise I'd
post them...sorry), but I'm not having much luck, if any.

What I'd like to do is search a Word doc for terms that are contained
in a text file (each term on a new line), then record the term and the
page number it appeared on to another text file - creating an index,
essentially.

Reading the text file is no big deal, I don't think. I've done that
with VBS before, so it can't be /that/ different in VBA.

What I need to figure out how to do is search the Word doc and return
the page number. I think I have to use a range for this in order to
get the correct page number, but this is all pretty new to me.

So, if anyone can help, I'd appreciate it.

Thanks!
Gabe

 

[Graham Mayor]

The following macro will search for all the words in a single column table
saved in a document indicated at sFname=
The search is case sensitive and works for whole words only.


Sub FindAndStoreList()
Dim ChangeDoc As Document, RefDoc As Document
Dim TargetDoc As Document
Dim cTable As Table
Dim sFindText As Range
Dim iPage As Integer
Dim rText As Range
Dim i As Long
Dim sFname As String
'********************************************
sFname = "D:\My Documents\Test\changes2.doc"
'********************************************
Set RefDoc = ActiveDocument
Set ChangeDoc = Documents.Open(sFname)
Set TargetDoc = Documents.Add
Set cTable = ChangeDoc.Tables(1)
RefDoc.Activate
Application.ScreenUpdating = False
For i = 1 To cTable.Rows.Count
Set sFindText = cTable.Cell(i, 1).Range
sFindText.End = sFindText.End - 1


With Selection
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(FindText:=sFindText, _
MatchWildcards:=False, MatchCase:=True, _
Wrap:=wdFindStop, MatchWholeWord:=True, _
Forward:=True) = True
Set rText = Selection.Range
iPage = Selection.Information(wdActiveEndAdjustedPageNumber)
'MsgBox iPage
'Exit Sub
TargetDoc.Activate
Selection.TypeText rText & vbTab & iPage & vbCr
RefDoc.Activate
Loop
End With
End With
Next i
Application.ScreenUpdating = True
End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Gabe Knuth]

Perfect! Oh man, thanks so much!

The following macro will search for all the words in a single column table
saved in a document indicated at sFname=
The search is case sensitive and works for whole words only.

Sub FindAndStoreList()
Dim ChangeDoc As Document, RefDoc As Document
Dim TargetDoc As Document
Dim cTable As Table
Dim sFindText As Range
Dim iPage As Integer
Dim rText As Range
Dim i As Long
Dim sFname As String
'********************************************
sFname = "D:\My Documents\Test\changes2.doc"
'********************************************
Set RefDoc = ActiveDocument
Set ChangeDoc = Documents.Open(sFname)
Set TargetDoc = Documents.Add
Set cTable = ChangeDoc.Tables(1)
RefDoc.Activate
Application.ScreenUpdating = False
For i = 1 To cTable.Rows.Count
Set sFindText = cTable.Cell(i, 1).Range
sFindText.End = sFindText.End - 1

With Selection
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
Do While .Execute(FindText:=sFindText, _
MatchWildcards:=False, MatchCase:=True, _
Wrap:=wdFindStop, MatchWholeWord:=True, _
Forward:=True) = True
Set rText = Selection.Range
iPage = Selection.Information(wdActiveEndAdjustedPageNumber)
'MsgBox iPage
'Exit Sub
TargetDoc.Activate
Selection.TypeText rText & vbTab & iPage & vbCr
RefDoc.Activate
Loop
End With
End With
Next i
Application.ScreenUpdating = True
End Sub

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP

My web sitewww.gmayor.com
Word MVP web sitehttp://word.mvps.org
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Graham Mayor]

You are welcome

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>