Finding rest of sentence after finding an specific word - excel

Question

I have created a code that searches different words in a column in a word document.
After finding the word, the code returns the value "yes" to the excel.
I want the code to extract the rest of the sentence after finding the word that I´m looking for.
The rest of the sentences are always something like:
Update system format.
Search for other inputs.
Havent found the sentence that it needs to do.
In conclusion, they are always a small sentence and a new paragraph after.
The code that I have developed is the following:
Sub findSubprocesos()
Dim wrdApp As New Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
Dim FindWord As String
Dim List As String
Dim Dict As Object
Dim NextFormula As Range
Dim RefElem As Range
Dim Key
Dim Wbk As Workbook: Set Wbk = ThisWorkbook
Set Dict = CreateObject("Scripting.Dictionary")
Set NextFormula = Worksheets("Datos2").Range("V2:V5")
With Dict
For Each RefElem In NextFormula
If Not .Exists(RefElem) And Not IsEmpty(RefElem) Then
Sheets("Datos2").Range("R3").Value = RefElem.Value
Debug.Print RefElem
FindSubs
On Error GoTo Skip
End If
Next RefElem
Skip:
End With
End Sub
Private Sub FindSubs()
Dim wrdApp As New Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
Dim FindWord As String
Dim List As String
Dim Dict As Object
Dim NextFormula As Range
Dim RefElem As Range
Dim Key
Dim Wbk As Workbook: Set Wbk = ThisWorkbook
Range("U3:U50").ClearContents
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open("C:\Users\rriveragarrido\Desktop\Proyectos\Proyecto solaris (endesa) (PROPIO)\prueba macros\ZZZ\Narrativas antiguas\1059\1059_NAR_OTC.RC.03.01_CC.END.GEN_ENG_31.12.20.docx", OpenAndRepair:=True)
Dim cell As Range
Dim bIsEmpty As Boolean
bIsEmpty = False
For n = 3 To 20
For Each cell In Worksheets("Datos").Range("S" & n)
If IsEmpty(cell) = False Then
FindWord = Wbk.Sheets("Datos2").Range("S" & n).Value 'Modify as necessary.
wrdApp.Selection.WholeStory
wrdApp.Selection.FIND.ClearFormatting
With wrdApp.Selection.FIND
.ClearFormatting
.Text = FindWord
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
If .Execute Then
Sheets("Datos2").Range("U" & n).Value = "Yes"
Else
'Sheets("Datos2").Range("T" & n).Value = "No"
wrdApp.Quit SaveChanges:=0
Sheets("Datos2").Range("U3:U50").Copy Sheets("Subprocesos").Range("A3:A50").End(xlToRight).Offset(0, 1)
GoTo Skip2
End If
End With
End If
Next cell
Next
Skip2:
End Sub
This is the part were I need to extract the rest of the sentence:
If .Execute Then
Sheets("Datos2").Range("U" & n).Value = "Yes"
Else
'Sheets("Datos2").Range("T" & n).Value = "No"
wrdApp.Quit SaveChanges:=0
Sheets("Datos2").Range("U3:U50").Copy Sheets("Subprocesos").Range("A3:A50").End(xlToRight).Offset(0, 1)
Currently is only writing "yes" when the sentence is found and pasting the information in a column and going to the next word if it is not found.

Answer 1

What you want to do is possible by using the Sentences collection of the document. Hopefully you can adapt the sample code below to your needs:
Option Explicit
Sub test()
Dim foundSentences As Collection
Set foundSentences = FindTheSentencesContaining(ThisWord:="access", _
FromThisDoc:="C:\Temp\test.docx")
If foundSentences Is Nothing Then
Debug.Print "The word doc was not found!"
Else
Debug.Print "found " & foundSentences.Count & " sentences"
Dim sentence As Variant
For Each sentence In foundSentences
Debug.Print sentence
Next sentence
End If
End Sub
Function FindTheSentencesContaining(ByVal ThisWord As String, _
ByVal FromThisDoc As String) As Collection
Dim wordWasRunning As Boolean
wordWasRunning = IsMSWordRunning
Dim wordApp As Word.Application
Set wordApp = AttachToMSWordApplication
On Error Resume Next
Dim wordDoc As Word.Document
Set wordDoc = wordApp.Documents.Open(Filename:=FromThisDoc, ReadOnly:=True)
On Error GoTo 0
If wordDoc Is Nothing Then Exit Function
Dim allSentences As Collection
Set allSentences = New Collection
Dim sentence As Variant
For Each sentence In wordDoc.Sentences
sentence.Select
With wordApp.Selection
.Find.Text = ThisWord
.Find.Forward = True
.Find.Wrap = wdFindStop
.Find.MatchCase = False
If .Find.Execute Then
'--- extend the selection to include the whole sentence
.Expand Unit:=wdSentence
allSentences.Add wordApp.Selection.Text
'--- move the cursor to the end of the sentence to continue looking
.Collapse Direction:=wdCollapseEnd
.MoveEnd Unit:=wdSentence
Else
'--- didn't find it, move to the next sentence
End If
End With
Next sentence
wordDoc.Close SaveChanges:=False
If Not wordWasRunning Then
wordApp.Quit
End If
Set FindTheSentencesContaining = allSentences
End Function
In a separate module, I have the following code (pulled from my library of code to reuse):
Option Explicit
Public Function IsMSWordRunning() As Boolean
'--- quick check to see if an instance of MS Word is running
Dim msApp As Object
On Error Resume Next
Set msApp = GetObject(, "Word.Application")
If Err > 0 Then
'--- not running
IsMSWordRunning = False
Else
'--- running
IsMSWordRunning = True
End If
End Function
Public Function AttachToMSWordApplication() As Word.Application
'--- finds an existing and running instance of MS Word, or starts
' the application if one is not already running
Dim msApp As Word.Application
On Error Resume Next
Set msApp = GetObject(, "Word.Application")
If Err > 0 Then
'--- we have to start one
' an exception will be raised if the application is not installed
Set msApp = CreateObject("Word.Application")
End If
Set AttachToMSWordApplication = msApp
End Function

Answer 2

A simple demo outputting the content to a message box, for all found instances:
Sub Demo()
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = InputBox("What is the Text to Find")
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Do While .Find.Execute
With .Duplicate
.End = .Sentences.First.End
MsgBox .Text
End With
.Collapse wdCollapseEnd
Loop
End With
End Sub
Do be aware, though, that VBA has no idea what a grammatical sentence is. For example, consider the following:
Mr. Smith spent $1,234.56 at Dr. John's Grocery Store, to buy:
10.25kg of potatoes; 10kg of avocados; and 15.1kg of Mrs. Green's Mt. Pleasant macadamia nuts.
For you and me, that would count as one sentence; for VBA it counts as 5 sentences.