ActiveDocument.BuiltInDocumentProperties

Sub test()
On Error Resume Next

Dim rw
Dim p

rw =  1 
Worksheets( 1 ).Activate
For Each p In ActiveWorkbook.BuiltinDocumentProperties
    Cells(rw,  1 ).Value = p.Name
    Cells(rw,  2 ).Value = p.Value
    rw = rw +  1 
Next
End Sub