Sub BMNames()
   ' Dim abookmark As Bookmark
    Dim abookmark As Variant
    Dim i As Integer
   ' Dim aMarks() As Integer
    Dim aMarks() As Variant
 
    Selection.EndKey Unit:=wdStory
    Set abookmark = ActiveDocument.Bookmarks
    If ActiveDocument.Bookmarks.Count >= 1 Then
    ReDim aMarks(ActiveDocument.Bookmarks.Count - 1)
    i = 0
    For Each abookmark In ActiveDocument.Bookmarks
        aMarks(i) = abookmark.Name
        Selection.TypeText Text:=abookmark.Name
        Selection.TypeParagraph
        i = i + 1
    Next abookmark
End If
    MsgBox "The active document contains " & _
    ActiveDocument.Bookmarks.Count & " bookmarks."
End Sub

Sub BMNames()
Dim oBM As Bookmark
Dim oRng As Range
Dim strList As String
    strList = ""
    If ActiveDocument.Bookmarks.Count > 0 Then
        For Each oBM In ActiveDocument.Range.Bookmarks
            strList = strList & oBM.name & vbCr
        Next oBM
        ActiveDocument.Range.InsertParagraphAfter
        Set oRng = ActiveDocument.Range
        oRng.Collapse 0

        oRng.Text = strList & vbCr & "The active document contains " & _
                    ActiveDocument.Bookmarks.Count & " bookmarks."
    Else
        MsgBox "There are no bookmarks in the document"
    End If
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub