Solved: Extract sentences containing a specific word to excel file

[Crossie]

Hi,

I am new to VB and am also new to the forum so i hope you guys can help me out. I want to create a Macro that will search for certain words in a document and extract both the sentence that contains them and also the sentence before and after that sentence to a excel spreadsheet. I found the code below submitted by Lucas on this site but it will only extract the sentence and not the ones either side. I was also wondering if it it is possible to record the document name and page number in seperate columns in the same spreadsheet. Any help you can give me would be greatly appreciated!

Thanks,
Crossie


Lucas' code:

Option Explicit

Sub FindWordCopySentence()
Dim appExcel As Object
Dim objSheet As Object
Dim aRange As Range
Dim intRowCount As Integer
intRowCount = 1
Set aRange = ActiveDocument.Range
With aRange.Find
Do
.Text = "shall" ' the word I am looking for
.Execute
If .Found Then
aRange.Expand Unit:=wdSentence
aRange.Copy
aRange.Collapse wdCollapseEnd
If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
'Change the file path to match the location of your test.xls
Set objSheet = appExcel.workbooks.Open("C:\temp\test.xls").Sheets("Sheet1")
intRowCount = 1
End If
objSheet.Cells(intRowCount, 1).Select
objSheet.Paste
intRowCount = intRowCount + 1
End If
Loop While .Found
End With
If Not objSheet Is Nothing Then
appExcel.workbooks(1).Close True
appExcel.Quit
Set objSheet = Nothing
Set appExcel = Nothing
End If
Set aRange = Nothing
End Sub

[fumei]

"extract both the sentence that contains them and also the sentence before and after that sentence"

You do not state if you want those other sentences separately from the sentence that has the search word. As in;

"Sentence BEFORE sentence with searchword. Sentence WITH searchword. Sentence AFTER sentence with searchword."

In other words, as ONE string.....

OR;

String_A = "Sentence BEFORE sentence with searchword."
String_B = "Sentence WITH searchword."
String_C = "Sentence AFTER sentence with searchword."

In other words, three separate strings.

In any case, it is not hard to do this (either way). You need to use another Range object. Here is an example.
Sub GetStuff()
Dim r As Range
Dim OtherRange As Range
Set r = ActiveDocument.Range
With r.Find
.ClearFormatting
.Text = "shall"
.Execute
If .Found = True Then
r.Expand Unit:=wdSentence
' r is now the sentence with the searchword
Set OtherRange = ActiveDocument.Range(Start:= _
(r.Next(Unit:=wdSentence, Count:=-1).Start), _
End:=(r.Next(Unit:=wdSentence, Count:=1).End))
' OtherRange is now the sentence BEFORE the sentence
' with searchword, the sentence with searchword, and
' the sentence AFTER the sentence with searchword
MsgBox OtherRange.Text
End If
End With
End Sub


To explain a bit more, OtherRange is a different range object. It is explicitly set with a Start and and End.

The Start:= r (the current range of the .Found).Next (sentence counting backwards, Count = -1).Start

The End:= r (the current range of the .Found).Next (sentence counting forwards, Count = 1).End

I know that looks a bit complicated, but it is not really. Demo attached. Click "Get Stuff" on the top toolbar.

As for your other questions.

The document name is ActiveDocument.Name

Page numbers are, or can be, a little tricky, but look up Information as a property of the range object.

[Crossie]

That works perfectly, thanks!

[lucas]

Hi Crossie,

When posting code, select the code and hit the vba button to format the code for the forum as I have done to your code in post #1.

Mark your thread solved using the thread tools at the top of the page please.

[kylefoley76]

I'm having problems with this too. I need to loop through the whole document and pick out all the sentences with a certain word in it. I built the following macro but it won't loop through the text, it will just print the first sentence with the word 'part' in it over and over again. Also if I could build a progress bar into that macro that would be great because I would like to eventually run this macro on a document with the maximum number of pages in word. I'm doing a study of how words are used.



Sub Find_sentences_with_specific_word()
Dim docTrg As Document
Dim rngTrg As Range
Dim r As Range
Set r = ActiveDocument.Range
Set docTrg = Documents.Add

With r.Find
.ClearFormatting
.Text = "part"
Do While .Execute
If .Found = True Then
r.Expand Unit:=wdSentence
Set rngTrg = docTrg.Range
rngTrg.Collapse wdCollapseEnd
rngTrg.Text = r.Text
rngTrg.InsertParagraphAfter
'MsgBox r.Text
End If
Loop
End With
End Sub

[gmayor]

Add

r.Collapse 0
before the lines

End If
Loop
End With
End Sub

[kylefoley76]

Thanks a lot for your help. It works. Do you know how to get it so that it only applies to a whole word because right now it will select words like 'compartment'?

[gmayor]

Change the line


Do While .Execute

to


Do While .Execute(MatchCase:=True, MatchWholeWord:=True)

The case matching is optional.