Dokumenteneigenschaft von Office Produkten auslesen

Sub DokumenteneigenschaftAuslesen()
  Dim i%
  Dim s$
  Dim oApp As Object
  
  Select Case s
    Case "Microsoft Word":  Set oApp = ActiveDocument
      Case ""
      Case ""
      Case Else
        Debug.Print Application.Name
  End Select
  
  On Error Resume Next
  'Einige Eigenschaten liefern einen Laufzeitfehler -2147467259
  'Excel
  'With ActiveWorkbook
  'Winword
  'With
  
  With oApp
    For i = 1 To .BuiltInDocumentProperties.Count
      s = .BuiltInDocumentProperties(i).Name & " : "
      s = s & .BuiltInDocumentProperties(i).Value
      Debug.Print s
    Next
  End With
End Sub

Title : Excel Grundlagen
Subject :
Author : Peter Test
Keywords :
Comments :
Template : X:\Templates\NeueVorlage.pot
Last author : Peter Test
Revision number : 37
Application name : Microsoft PowerPoint
Last print date : 31.07.2002 12:51:14
Creation date : 20.01.2005 16:20:21
Last save time : 30.11.2008 12:39:55
Total editing time : 5
Number of pages :
Number of words : 26
Number of characters :
Security :
Category :
Format : Bildschirmpräsentation
Manager :
Company : Test Gmbh
Number of bytes : 88836
Number of lines :
Number of paragraphs : 4
Number of slides : 2
Number of notes : 2
Number of hidden Slides : 0
Number of multimedia clips : 0
Hyperlink base :
Number of characters (with spaces) :

 

In diesem Bsp. werden die Eigenschaften Autor, Letzer Bearbeiter und Firma für alle geöffneten Präsentationen geändert.

Sub DokumenteneigenschaftVerändern()
  Dim i%
  Dim s$
  On Error GoTo Errors_
  Dim obj As Object
  'Für Winword einfach Presentations mit Documents austauschen
  'Application.Documents
  'Dito mit Excel
  'Application.Workbooks
  'Powerpoint
  For Each obj In Application.Presentations
    With obj
      .BuiltinDocumentProperties("Author") = "Tom Test"
      .BuiltinDocumentProperties("Last author") = "Tom Test"
      .BuiltinDocumentProperties("Company") = "Test Inc."
      'Änderung sichern (einkommentieren )
      '.Save
    End With
  Next
  Exit Sub
Errors_:
  'Debug.Print Err.Number; " "; Err.Description
  Resume Next
End Sub