Get heading information using a wild card search loop in MS Word using VBA - vba

Question

I am doing a wildcard search loop in MS Word and generating the list of all the find values in a new document using following code. I have added page numbers to the output. But I can't think of how to get the headers for the searched output. Pls suggest.
Sample Word Document:
1 Heading
Text Text Text Text Text
--<Page Break>--
1.1 Heading
Text Text Text Text Text [Reference X1]
1.1.1 Heading
Text Text Text Text Text
Text Text Text Text Text
Text Text Text Text Text
--<Page Break>--
1.2 Heading
Text Text Text Text Text
1.2.1 Heading
Text Text Text Text Text
Text Text Text Text Text [Reference X2]
Text Text Text Text Text [Reference X3]
The 1, 1.1, etc headings are the default heading styles used in MS word. (For me the style name is "Heading 1", "Heading 2", etc.)
The output I am expecting is as under in a tabular format:
| Reference | Heading | Page |
| Reference X1 | 1.1 Heading | 2 |
| Reference X2 | 1.2.1 Heading | 3 |
| Reference X2 | 1.2.1 Heading | 3 |
The Code (part of the sub that does this finding and writing in the table) I have been able to write so far is:
With oDoc
Set oRange = .Range
n = 1
With oRange.Find
.Text = "<Reference X[0-9]{1,}>"
.Forward = True
.MatchWildcards = True
Do While .Execute
strFound = oRange
With oTable
.Cell(n+1,1).Range.Text = strFound
.Cell(n+1,3).Range.Text = oRange.Information(wdActiveEndPageNumber)
End With
n = n + 1
Loop
End With
End With
I already have the code for defining these variables, creating a table and required rows in it. I am only confused about how to get the heading just above the found item. The issue is there can be one or multiple "Reference XX" under one heading. Further, the heading level can be any. And I need separate rows for each item found using the wildcard.

Answer 1

For example:
Sub GetRefHeadings()
Application.ScreenUpdating = False
Dim Rng As Range, StrOut As String, Tbl As Table
StrOut = "Ref." & vbTab & "Heading" & vbTab & "Page" & vbCr
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "<Reference X[0-9]#>"
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
Do While .Find.Execute
Set Rng = .Paragraphs(1).Range
Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
StrOut = StrOut & .Text & vbTab & Rng.Paragraphs.First.Range.ListFormat.ListString & _
" " & Split(Rng.Text, vbCr)(0) & vbTab & Rng.Information(wdActiveEndPageNumber) & vbCr
Loop
End With
Set Rng = ActiveDocument.Range.Characters.Last
Rng.Text = StrOut
Set Tbl = Rng.ConvertToTable(Separator:=vbTab)
With Tbl
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 100
.Columns.PreferredWidthType = wdPreferredWidthPercent
.Columns(1).PreferredWidth = 20
.Columns(2).PreferredWidth = 70
.Columns(3).PreferredWidth = 10
.Rows(1).Range.Font.Bold = True
.Rows(1).HeadingFormat = True
'.Sort ExcludeHeader:=True, FieldNumber:=1
End With
Set Rng = Nothing: Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub
If you want the found text's page # instead of the heading's page #, change Rng.Information to .Information.
The default sort order is by reference found, regardless of the Reference #, which coincides with sorting by Heading. The code also includes a commented-out line to sort by Reference # instead.

Answer 2

You can find the heading level of the section of text you've found using a predefined bookmark. Since this trick uses the Selection object, you have to transfer the "found text" range to Selection. This code snippet below shows how:
Option Explicit
Sub test()
With ActiveDocument
Dim foundThis As Range
Set foundThis = .Range
With foundThis.Find
.Text = "<Reference X[0-9]{1,}>"
.Forward = True
.MatchWildcards = True
Do While .Execute
Dim strFound As String
Dim heading As String
strFound = foundThis.Text
heading = foundThis.GoTo(What:=wdGoToBookmark, _
Name:="\HeadingLevel").Paragraphs(1).Range.Text
Debug.Print "string found: " & strFound & " on page " & _
foundThis.Information(wdActiveEndPageNumber) & _
", Heading: " & heading
Loop
End With
End With
End Sub