How do I convert msWord headings into a Table preserving paragraph levels

Question

I need to convert a Word document that has been developed using outline view into a table in such a way that preserves the heading levels and converts them to columns. The format looks something like:

========================================
Heading 1  |  Heading 2  |  Heading 3
========================================
Title 1.0  |  Title 1.1  |  Title 1.1.1
----------------------------------------
           |  Title 1.2  |  
----------------------------------------
           |  Title 1.3  |  Title 1.3.1
----------------------------------------
Title 2.0  |  Title 2.1  |  Title 2.1.1
----------------------------------------

Answer 1

As requested, here is the answer.

Solution: I used the code here: Getting the headings from a Word document which was a great start - thanks VonC And made a few mods to the CreateOutline subroutine:

Public Sub CreateOutline()
    Dim docOutline As Word.Document
    Dim docSource As Word.Document
    Dim rng As Word.Range

    Dim astrHeadings As Variant
    Dim strText As String
    Dim intLevel As Integer
    ' ========================================
    ' Added a static variable to retain the 
    ' last paragraph outline level
    ' ========================================
    Static intLastLevel As Integer
    ' ========================================
    Dim intItem As Integer

    Set docSource = ActiveDocument
    Set docOutline = Documents.Add
    ' Content returns only the
    ' main body of the document, not
    ' the headers and footer.
    Set rng = docOutline.Content

    astrHeadings = docSource.GetCrossReferenceItems(wdRefTypeHeading)
    For intItem = LBound(astrHeadings) To UBound(astrHeadings)
        ' Get the text and the level.
        strText = Trim$(astrHeadings(intItem))
        intLevel = GetLevel(CStr(astrHeadings(intItem)))

        ' ========================================
        ' If the paragraph level is increasing, add a tab,
        ' if decreasing add a new line, and insert the appropriate 
        ' tabs as prefix.
        ' ========================================
        If intLevel > intLastLevel Then
            strText = vbTab & strText
        Else
            strText = vbNewLine & String(intLevel, Chr(9)) & strText
        End If
        ' ========================================

        ' Add the text to the document.
        rng.InsertAfter strText
        ' Set the style of the selected range and
        ' then collapse the range for the next entry.
        ' rng.Style = "Heading " & intLevel       ' Removed the style setting
        ' ========================================
        ' Remeber the current paragraph level
        ' ========================================
        intLastLevel = intLevel
        rng.Collapse wdCollapseEnd
    Next intItem
End Sub

Private Function GetLevel(strItem As String) As Integer
    ' Return the heading level of a header from the
    ' array returned by Word.

    ' The number of leading spaces indicates the
    ' outline level (2 spaces per level: H1 has
    ' 0 spaces, H2 has 2 spaces, H3 has 4 spaces.

    Dim strTemp As String
    Dim strOriginal As String
    Dim intDiff As Integer

    ' Get rid of all trailing spaces.
    strOriginal = RTrim$(strItem)

    ' Trim leading spaces, and then compare with
    ' the original.
    strTemp = LTrim$(strOriginal)

    ' Subtract to find the number of
    ' leading spaces in the original string.
    intDiff = Len(strOriginal) - Len(strTemp)
    GetLevel = (intDiff / 2) + 1
End Function

I then highlighted the entire output in the new document and converted it to a table. The only issue I had was a 'blank' first column which was easy to fix, and then added the necessary formatting for headers.

Hope others find this useful.