user6718894
user6718894

Reputation: 11

Excel VBA to get page numbers from Found text in Word

I am new to VBA and I am trying to put together a macro in Excel. This macro is to search a Word document for a specific text string and return the page number where it is located (i.e. the column will say "### is found on page # of the document").

I seem to be very close to what I want. The macro finds the text and I can get it to tell me it found/didn't find it. However, when I run it with code to return the page number, it tells me the index is out of range. I'm sure the difficulty is with my limited understanding of the objects and their properties.

Any help is appreciated!

    Sub OpenWordDoc()
       Set wordapp = CreateObject("word.Application")
         wordapp.Visible = True
         wordapp.Activate
         wordapp.Documents.Open "filename.docx"
         Set findRange = Sheet1.Range("D4:D8")
         For Each findCell In findRange.Cells
           Set rngFound = wordapp.ActiveDocument.Range.Find
           rngFound.Text = findCell.Value
           rngFound.Execute
           If rngFound.Found Then
              findCell.Offset(columnOffset:=1) =  rngFound.Parent.Information(wdActiveEndPageNumber)
           Else
              findCell.Offset(columnOffset:=1) = findCell.Value
           End If
        Next findCell
     wordapp.Quit
     Set wordapp = Nothing
    End Sub

Edit 1: I have tried this on a completely different computer and different versions of Word and Excel. The same message pops up. The error is this piece - rngFound.Parent.Information(wdActiveEndPageNumber) - and I think the rngFound.Parent is not acting as a "selection". I also tried replacing the wdActiveEndPageNumber with wdNumberOfPagesInDocument just to see if it was the specific value and got the same error message.

Upvotes: 1

Views: 3928

Answers (1)

xidgel
xidgel

Reputation: 3145

Try something like this:

Sub OpenWordDoc()
    Dim wordapp As Word.Application
    Dim findRange As Excel.Range
    Dim findCell As Excel.Range
    Dim rngFound As Word.Range

    Set wordapp = CreateObject("word.Application")
    wordapp.Visible = True
    wordapp.Activate
    wordapp.Documents.Open "filename.docx"
    Set findRange = Sheet1.Range("D4:D8")
    For Each findCell In findRange.Cells
        Set rngFound = wordapp.ActiveDocument.Range
        With rngFound.Find
            .Text = findCell.Value
            .Execute
        End With
        If rngFound.Find.Found Then
            findCell.Offset(columnOffset:=1) = rngFound.Information(wdActiveEndPageNumber)
        Else
            findCell.Offset(columnOffset:=1) = findCell.Value
        End If
    Next findCell
    wordapp.Quit

    Set rngFound = Nothing
    Set findCell = Nothing
    Set findRange = Nothing
    Set wordapp = Nothing
End Sub

Hope that helps

Upvotes: 1

Related Questions