[Matt Shaw]

I'm looking for some sample VBA code to find certain key words in a
Word Document and for each occasion that the word appears, export the
entire sentence and the page number that the sentence appears on, to
an Excel workbook.

So for example, if the key word was "fox" and on page 4 was the
sentence : "The quick brown fox jumped over the lazy dog" - then this
entire sentence would be exported to Excel so that in column 1 was the
sentence and in column 2 would be "4" the page number.

Anyone had reason to do something similar like this?

Matt.

[Techie Nowix]

Solution:
1. Get the Search Word from the excel sheet
2. Initialize the excel sheet by clearing any previous search results
3. For each sentence in the word document, do steps 4-8
4. Select the sentence
5. Execute a find for the search word
6. If a match is found, use Selection.Information to find the page
number
7. Increment the number of search results
8. Export the sentence and the page number to the excel sheet
9. Export the number of search results into the excel sheet

Code:
Sub SentenceFind()
'This macro finds the sentence with a specific word
'The sentence and the page number of the sentence is stored in an excel
worksheet
'The excel worksheet is named Search.xls and is located in the same
folder
'The worksheet has the format
'Search Word: WordName
'Sentence, Page Number

'Open the Excel sheet and get the search word
Dim oExcel As Excel.Application
Dim oBook As Excel.Workbook
Const FileName As String = "Search.xls"
Dim FullPath As String
FullPath = ActiveDocument.Path & "\" & FileName


If Tasks.Exists("Microsoft Excel") = True Then
Set oExcel = GetObject(, "Excel.Application")
Else
Set oExcel = CreateObject("Excel.Application")
End If
oExcel.Visible = True


If oExcel.Workbooks.Count 0 Then
Dim BookOpened As Boolean
BookOpened = False
For Each oBook In oExcel.Workbooks
If (oBook.Name = FileName) Then
BookOpened = True
Exit For
End If
Next
If (BookOpened = False) Then
Set oBook = oExcel.Workbooks.Open(FullPath)
End If
Else
Set oBook = oExcel.Workbooks.Open(FullPath)
End If

If (oBook.Worksheets("Search").Range("B2").Value 0) Then
'Clear earlier contents
EndNo = 3 + oBook.Worksheets("Search").Range("B2").Value
EndCell = "B" & EndNo
oBook.Worksheets("Search").Range("A4:" & EndCell).Cells.Delete
End If

Dim SearchWord As String
Dim Sentence As String
Dim PageNo As Integer
Dim SearchNumber As Integer
SearchNumber = 0
SearchWord = oBook.Worksheets("Search").Range("B1").Value

Dim oRange As Range
For Each oRange In ActiveDocument.Sentences
Sentence = oRange.Text
oRange.Select
With oRange.Find
.Text = SearchWord
.Execute
End With
If (oRange.Find.Found = True) Then
SearchNumber = SearchNumber + 1
PageNo =
ActiveWindow.Selection.Information(wdActiveEndAdju stedPageNumber)
InsertSearch oBook, Sentence, PageNo, SearchNumber
End If
Next
oBook.Sheets("Search").Range("B2").Value = SearchNumber
Set oExcel = Nothing
End Sub

Sub InsertSearch(oBook As Excel.Workbook, Sentence As String, PageNo As
Integer, SearchNumber As Integer)
'This helper function inserts a sentence and page no into the excel
worksheet
Dim oSheet As Excel.Worksheet
Dim Row As Integer
Set oSheet = oBook.Worksheets("Search")
Row = SearchNumber + 3 'first three lines in sheet contain text
oSheet.Cells(Row, 1) = Sentence
oSheet.Cells(Row, 2) = PageNo
oBook.Save
End Sub

Excel Sheet Format:
Search Word: house
Number of searches: 0
Sentence Page No
Sentence 1 1

For more details http://www.nowix.com/Word2Excel/Solution.html


For your VBA needs - Ask Nowix: http://www.Nowix.com

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!