<p>How do I get a list of all the headings in a word document by using VBA?</p>

You mean like this
createOutline
function (which actually copy all headings from a source word document into a new word document):
(I believe the
```
astrHeadings = docSource.
GetCrossReferenceItems
(wdRefTypeHeading)
```
function is the key in this program, and should allow you to retrieve what you are asking for)
```
```
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
    Dim intItem As Integer
        
    Set docSource = ActiveDocument
    Set docOutline = Documents.Add
    
    ' Content returns only the main body of the document, not the headers/footer.        
    Set rng = docOutline.Content
    ' GetCrossReferenceItems(wdRefTypeHeading) returns an array with references to all headings in the document
    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)))
        
        ' Add the text to the document.
        rng.InsertAfter strText & vbNewLine
        
        ' Set the style of the selected range and
        ' then collapse the range for the next entry.
        rng.Style = "Heading " & 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
```
```
UPDATE by @kol on March 6, 2018
Although
```
astrHeadings
```
is an array (
```
IsArray
```
returns
```
True
```
, and
```
TypeName
```
returns
```
String()
```
) I get a
```
type mismatch
```
error when I try to access its elements in VBScript (v5.8.16384 on Windows 10 Pro 1709 16299.248). This must be a VBScript-specific problem, because I can access the elements if I run the same code in Word's VBA editor. I ended up iterating the lines of the TOC, because it works even from VBScript:
```
```
For Each Paragraph In Doc.TablesOfContents(1).Range.Paragraphs
  WScript.Echo Paragraph.Range.Text
Next
```
```