CODEWITHSUNDEEP
vbaexcelms-word
Alex27
Alex27

Reputation: 89

Search between specific words in Word document

This macro searches for words through the Word document: Set r = WordDoc.Range. Is it possible to make it search only between specific words in Word document? Example: search only from "Word1" to "Word2". I know that I need to find these words and set them as Range.Start and Range.End, but i'm not good at this. Can someone help me with code?

Sub test()
Dim Word As Object, WordDoc  As Object
Dim r As Boolean, f As Boolean, fO As Long
Set Word = CreateObject("Word.Application")
Set WordDoc = Word.Documents.Open(Filename:=Application.ThisWorkbook.path & "\test.docx")

'''name'''
Set r = WordDoc.Range
Do While UnifiedSearch(r, "name*book1")
    If f Then
        If r.Start = fO Then
            Exit Do
        End If
    Else
        fO = r.Start
        f = True
    End If
    WordDoc.Range(r.Start + 4, r.End - 5).Copy
    Range("C4").Select
    ActiveSheet.Paste
    Set r = WordDoc.Range(r.End, r.End)
Loop

WordDoc.Close
Word.Quit

End Sub

Private Function UnifiedSearch(r As Range, s As String) As Boolean

     With r.Find
        .ClearFormatting
        .Text = s
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        UnifiedSearch = .Execute
    End With

End Function

Upvotes: 1

Views: 412

Answers (1)

Cindy Meister
Cindy Meister

Reputation: 25703

I'm not clear what all your code is supposed to be doing, but I changed the first part to search the two terms, then set the range to be searched to everything between the two terms (including the terms, themselves). I used multiple ranges so that it's always clear what Range refers to which content.

I had to make some corrections to your code, for example you declared r as a Boolean, when it should be a Word.Range. I also had to change the object of the Word application since a Range needs to be declared using Word.Range in order to distinguish in from an Excel Range. Or you need to change these declarations to Object if you don't set a reference to Word's object library.

Notice how the Duplicate property needs to be used in order to "copy" a Range to an independent Range object.

Sub test()
    Dim wd As Object, WordDoc  As Object
    Dim r As Word.Range, f As Boolean, fO As Long
    Dim rStart As Word.Range, rEnd As Word.Range, rSearch As Word.Range

    Set wd = CreateObject("Word.Application")
    Set WordDoc = wd.Documents.Open(Filename:=Application.ThisWorkbook.path & "\test.docx")

    '''name'''
    Set r = WordDoc.content
    Set rStart = r.Duplicate
    If Not UnifiedSearch(rStart, "Word 1") Then
        Exit Sub
    End If
    Set rEnd = rStart.Duplicate
    rEnd.End = r.End

    If Not UnifiedSearch(rEnd, "Word 2") Then
        Exit Sub
    End If
    Set rSearch = r.Duplicate
    rSearch.Start = rStart.Start
    rSearch.End = rEnd.End

    Do While UnifiedSearch(rSearch, "name*book1")
        If f Then
            If r.Start = fO Then
                Exit Do
            End If
        Else
            fO = r.Start
            f = True
        End If
        WordDoc.Range(r.Start + 4, r.End - 5).Copy
        Range("C4").Select
        ActiveSheet.Paste
        Set r = WordDoc.Range(r.End, r.End)
    Loop
'

    WordDoc.Close
    Set WordDoc = Nothing
    wd.Quit
    Set wd = Nothing

End Sub

Private Function UnifiedSearch(ByRef r As Range, s As String) As Boolean
    Dim found As Boolean

     With r.Find
        .ClearFormatting
        .Text = s
        .Forward = True
        .wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        found = .Execute
    End With
    Debug.Print found, s
        UnifiedSearch = found

End Function

Upvotes: 1

Related Questions