Попробуй так... (отсей,что не нужно)
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
Stepler ^{(щёлк-щёлк!!)}