Finding rest of sentence after finding an specific word

user_17542634 0
Viewed 68

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.

ms-word vba excel
2 Answers

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
user_47177550

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.

user_91702740
Related