How would I extract paragraph/list numbers and the paragraph text in VBA

[Gilgamesh1964]

Hello,

I want like to have a VBA macro that will set a string for the paragraph/list number for every paragraph in the document along with a string for the text. For paragraphs that do not have a number then the first string should be empty.

For a document that might contain the following text:

1 This is a numbered heading

1.1 This is also a numbered heading

1.1.1 This is a paragraph that has a number on it

This is a paragraph that does not have a number on it

1. This is a level 1 list entry

          (a) This is a level 2 list entry

I would be hoping to get the following

String 1	String 2
1	This is a numbered heading
1.1	This is also a numbered heading
1.1.1	This is a paragraph that has a number on it
	This is a paragraph that does not have a number on it
1	This is a level 1 list entry
(a)	This is a level 2 list entry

I am fairly competent with VBA on Excel and Project but I have barely touched Word.

So, if someone could direct me to the appropriate Word objects and fields I would need I would appreciate it.

Thanks in advance

[#2 · Accepted solution]

@Gilgamesh1964 

You should be able to use the ListString property to retrieve the number format for each level. See https://wordmvp.com/FAQs/Numbering/ListString.htm.

[#3]

@Gilgamesh1964 Run a macro containing the following code when you have the document open

Dim docsource As Document, doctarget As Document
Dim i As Long
Dim tbl As Table
Dim newrow As Row
Set docsource = ActiveDocument
Set doctarget = Documents.Add
With doctarget
    Set tbl = .Tables.Add(Selection.Range, 1, 2)
    With tbl
        .Cell(1, 1).Range.Text = "String 1"
        .Cell(1, 2).Range.Text = "String 2"
    End With
End With
With docsource
    .ConvertNumbersToText
    For i = 1 To .Paragraphs.Count
        Set newrow = tbl.Rows.Add
        If Left(.Paragraphs(i).Style, 7) = "Heading" Then
            With newrow
                .Cells(1).Range.Text = Left(docsource.Paragraphs(i).Range.Text, InStr(docsource.Paragraphs(i).Range.Text, vbTab) - 1)
                .Cells(2).Range.Text = Mid(docsource.Paragraphs(i).Range.Text, InStr(docsource.Paragraphs(i).Range.Text, vbTab) + 1)
            End With
        Else
            newrow.Cells(2).Range.Text = .Paragraphs(i).Range.Text
        End If
    Next i
    .Close wdDoNotSaveChanges
End With
doctarget.Activate

[#4]

Thank you both for replying.
I now have a solution that works for me.