Word to Excel data transfer of bookmark section locations (cross references) - excel

Question

I am trying to obtain the numbered locations of my bookmarks (paragraph number without context) in a Word document (a lengthy legal document template) and. I am currently using the following code to pull the bookmarked text values from the Word document into an Excel workbook I've built out to grab other data from other sources, but I haven't been able to figure out how to manipulate the code to grab the bookmark's paragraph numbers (I searched high and low for this one too, and am a VBA newbie. I know just enough to be dangerous, but not enough to be helpful lol). Please Help!
Sub SectionLocationImportTESTING()
Dim intDocCount As Integer
Dim wdApp As Word.Application, wdDoc As Word.Document, xlWb As Excel.Workbook, xlWs As Excel.Worksheet
Dim BookmarkText As String
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0
If wdApp Is Nothing Then
MsgBox "There are no MS Word Documents open.", vbInformation, "No Word Documents open"
Exit Sub
End If
Set xlWb = ThisWorkbook
Set xlWs = ActiveWorkbook.Sheets("Data Input")
intDocCount = wdApp.Documents.Count
If intDocCount > 1 Then
MsgBox "There are " & intDocCount & " Word Documents open." & vbNewLine & vbNewLine & _
"Please close the additional MS Word Documents", vbCritical, "Too many Word Documents open!"
Set wdApp = Nothing
Exit Sub
End If
With wdApp
Set wdDoc = wdApp.ActiveDocument
wdDoc.Activate
'This is very abbreviated, I have about 300 bookmarks that transfer
If wdDoc.Bookmarks.Exists("Section_Rent") = True Then
BookmarkText = wdDoc.Bookmarks("Section_Rent").Range.Text
xlWs.Cells(202, 22) = ("Section_Rent")
xlWs.Cells(202, 23) = BookmarkText
End If
End With
ActiveWorkbook.RefreshAll
ActiveSheet.PivotTables("Data_Input_Table").PivotFields("Trimmed Data"). _
PivotFilters.Add2 Type:=xlCaptionIsGreaterThan, Value1:="0"
Columns("D:D").EntireColumn.AutoFit
Range("A1").Select
MsgBox "Transfer is complete."
End Sub

Answer 1

I don't think there's a straight-forward way of doing that.
You could do this for example:
Sub Tester()
Debug.Print ParagraphNumber(Selection.Range)
End Sub
Function ParagraphNumber(rng As Range)
ParagraphNumber = rng.Document.Range(0, rng.End).Paragraphs.Count
End Function
...but it will also count "empty" paragraphs.
If you have a lot of bookmarks, you could consider listing the names in your Excel sheet and then looping over that range to run the text extraction. If you hard-code all those names into your VBA that's going to be very hard to maintain.
E.g.
'...
Dim c As Range, bm As String, rngBM As Word.Range
'...
'...
Set wdDoc = wdApp.ActiveDocument
wdDoc.Activate
'range with your bookmark names
Set rngBM = ThisWorkbook.Sheets("Bookmarks").Range("A2:A300")
For Each c In rngBM.Cells
bm = c.Value 'bookmark name
If wdDoc.Bookmarks.Exists(bm) Then
Set rngBM = wdDoc.Bookmarks(bm).Range
'for demo purposes just putting info next to the bookmark name...
c.Offset(0, 1).Value = rngBM.Text
c.Offset(0, 2).Value = ParagraphNumber(rngBM)
End If
Next c

Answer 2

There's 2 ways to get the paragraph number, depending on what you want:
Option 1
This will get the exact string of the auto-numbering that you see in the paragraph itself:
E.g. the below paragraph will get you 1.
This is a test paragraph.
If wdDoc.Bookmarks.Exists("Section_Rent") Then
Dim BookmarkText As String
BookmarkText = wdDoc.Bookmarks("Section_Rent").Range.Text
xlWs.Cells(202, 22) = "Section_Rent"
xlWs.Cells(202, 23) = BookmarkText
Dim BookmarkParaNum As String
BookmarkParaNum = wdDoc.Bookmarks("Section_Rent").Range.ListFormat.ListString
xlWs.Cells(202, 24) = BookmarkParaNum
End If
Option 2
This will get the string that you see if you insert a cross reference to the paragraph:
Using the below code for the same paragraph in Option 1 will give you just 1, the same as what inserting it as cross reference will get you.
wdDoc.Paragraphs.Last.Range.InsertParagraphAfter 'A temporary paragraph for inserting field later
Dim fieldRng As Range
Set fieldRng = wdDoc.Paragraphs.Last.Range.Duplicate
If wdDoc.Bookmarks.Exists("Section_Rent") Then
Dim BookmarkText As String
BookmarkText = wdDoc.Bookmarks("Section_Rent").Range.Text
xlWs.Cells(202, 22) = "Section_Rent"
xlWs.Cells(202, 23) = BookmarkText
fieldRng.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:=wdNumberNoContext, ReferenceItem:="Section_Term", InsertAsHyperlink:=True, IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
Dim tempField As Field
Set tempField = fieldRng.Fields(1)
Dim BookmarkParaNum As String
BookmarkParaNum = tempField.Result
xlWs.Cells(202, 24) = BookmarkParaNum
tempField.Delete
End If
fieldRng.Delete 'Delete the temporary paragraph