Word, VBA, ListOfDocumentProperties

Private Sub CommandButton1_Click()

ActiveDocument.Content.Delete

Dim countOfProperties As Integer
Dim counter As Integer

ActiveDocument.Content.InsertAfter Text:="BuiltInDocumentProperties" & vbNewLine

For Each fileProperty In ActiveDocument.BuiltInDocumentProperties
    countOfProperties = countOfProperties + 1
    On Error Resume Next
    Debug.Print fileProperty.Name & ": " & fileProperty.Value
Next fileProperty

Set tblNew = ActiveDocument.Tables.Add(Selection.Range, countOfProperties, 3)
With tblNew
  For Each fileProperty In ActiveDocument.BuiltInDocumentProperties
    counter = counter + 1
    .Cell(counter, 1).Range.InsertAfter counter
    .Cell(counter, 2).Range.InsertAfter fileProperty.Name
    On Error Resume Next
    .Cell(counter, 3).Range.InsertAfter fileProperty.Value
  Next fileProperty
  .Columns.AutoFit
End With


ActiveDocument.Content.InsertAfter Text:="CustomDocumentProperties" & vbNewLine

For Each fileProperty In ActiveDocument.CustomDocumentProperties
    countOfProperties = countOfProperties + 1
    On Error Resume Next
    Debug.Print fileProperty.Name & ": " & fileProperty.Value '& vbNewLine
Next fileProperty

End Sub