ActiveWorkbook.BuiltinDocumentProperties(7)

Sub DokumenteneigenschaftAuslesen()
Dim i As Integer
Dim s As String
On Error Resume Next
Sheets.Add after:=Sheets(Sheets.Count)
With ActiveWorkbook
For i = 1 To .BuiltinDocumentProperties.Count
s = .BuiltinDocumentProperties(i).Name & " : "
s = s & .BuiltinDocumentProperties(i).Value
Cells(i, 1).Value = s
Next
'Author ändern in "Nobody" mit…
ActiveWorkbook.BuiltinDocumentProperties(3).Value = "Nobody"
'Last Author ändern bzw. zuletzt gespeichert von "Nobody2"
ActiveWorkbook.BuiltinDocumentProperties(7).Value = "Nobody2"
End With
End Sub