Auslesen von Datei-Eigenschaften via VBA-Script in Word

Dieses Thema Auslesen von Datei-Eigenschaften via VBA-Script in Word im Forum "Microsoft Office Suite" wurde erstellt von Emanuel, 12. Nov. 2004.

Thema: Auslesen von Datei-Eigenschaften via VBA-Script in Word Hallo, ist es mit VBA für Word möglich die erweiterten Datei-Eigenschaften wie Titel, Thema, Autor, Manager, usw....

  1. Hallo,

    ist es mit VBA für Word möglich die erweiterten Datei-Eigenschaften wie Titel, Thema, Autor, Manager, usw. auszulesen. In meinen Fall wäre das entsprechende Dokument auch schon offen.
    :D Ich bin für jede Antwort dankbar.
     
  2. Hallo Emanuel,

    der folgende Makro erstellt eine Tabelle und listet die Dokumenteneigenschaften auf:
    - Name der Eigenschaft
    - Index der Eigenschaft
    - Wert der Eigenschaft

    Am Ende stehen 2 Beispiele für den Zugriff auf die Eigenschaft->Titel', einmal über den Namen und einmal über den Index.

    Gruß Matjes ;)

    Code:
    Option Explicit
    
    Sub DocumentEigenschaftenAuflisten()
    
      Dim p As Variant, my_tab As Table, z As Long, l_index As Long
      
     ->Schreibmarke ans Ende des Dokumentes stellen
      Selection.WholeStory
      Selection.Collapse Direction:=wdCollapseEnd
      
     ->Absatz einfügen
      With Selection
        .InsertParagraphAfter: .Collapse Direction:=wdCollapseEnd
        .Font.Bold = True: .Font.Size = 14: .Font.Name = Tahoma
        .InsertAfter Dokument Eigenschaften
        .InsertAfter vbCrLf
        .Collapse Direction:=wdCollapseEnd
      End With
    
     ->Tabelle einfügen:
     ->Zeilen entsprechend der Anzahl Eigenschaften +1 für Überchrift
      With Selection
        .Font.Bold = False: .Font.Size = 10: .Font.Name = Tahoma
        .InsertParagraphAfter
        .Collapse Direction:=wdCollapseEnd
        .InsertParagraphAfter
      End With
      Set my_tab = ActiveDocument.Tables.Add(Selection.Range, _
          ActiveDocument.BuiltInDocumentProperties.Count + 1, 3)
        
     ->Zeilenindex auf Anfang
      z = 1
     ->Tabellen-Überschriften
      my_tab.Cell(z, 1).Range.InsertAfter Name
      my_tab.Cell(z, 1).Range.Font.Bold = True
      my_tab.Cell(z, 2).Range.InsertAfter Index
      my_tab.Cell(z, 2).Range.Font.Bold = True
      my_tab.Cell(z, 3).Range.InsertAfter Wert
      my_tab.Cell(z, 3).Range.Font.Bold = True
     ->Zeilenindex auf nächste Zeile
      z = z + 1
     ->Name,Index und Wert der Eigenschaften in Tabelle eintragen
      l_index = 0
      For Each p In ActiveDocument.BuiltInDocumentProperties
        my_tab.Cell(z, 1).Range.InsertAfter p.Name
        l_index = l_index + 1
        my_tab.Cell(z, 2).Range.InsertAfter l_index
        On Error GoTo LeererWert
        my_tab.Cell(z, 3).Range.InsertAfter p.Value
       ->Zeilenindex weiterschalten
        z = z + 1
      Next
      On Error GoTo 0
      
     ->optimale Breite der Spalten setzen
      For l_index = 1 To 3
        my_tab.Columns(l_index).AutoFit
      Next
      
     ->Schreibmarke hinter die Tabelle
      my_tab.Select
      Selection.Collapse Direction:=wdCollapseEnd
      Selection.InsertParagraphAfter
      Selection.Collapse Direction:=wdCollapseEnd
    
      Selection.InsertAfter _
        Auf die DokumentEigenschaften kann über  & _
        den Namen oder den Index zugegriffen werden.  & _
        Dazu zwei Beispiele für den Zugriff auf->Titel': & _
        vbCrLf & vbCrLf & _
        Index: & vbCrLf & _
        ActiveDocument.BuiltInDocumentProperties(Title).Value & _
         = Titel über Name gesetzt & _
        Name: & vbCrLf & _
        ActiveDocument.BuiltInDocumentProperties(1).Value & _
         = Titel über Index gesetzt
      
      Set my_tab = Nothing
    Exit Sub
    LeererWert:
      my_tab.Cell(z, 3).Range.InsertAfter kein Wert
      Resume Next
    End Sub
    
    Sub DocEigenscaften_Setzen1()
      ActiveDocument.BuiltInDocumentProperties(Title).Value = Titel über Name gesetzt
    End Sub
    Sub DocEigenscaften_Setzen2()
      ActiveDocument.BuiltInDocumentProperties(1).Value = Titel über Index gesetzt
    End Sub
     
  3. Ola,

    vielleicht ist noch anzumerken, dass es für die meisten dieser Eigenschaften auch einfache Feldfunktionen gibt, mit denen die Eigenschaften ohne Makro einfach in den Text gezogen werden können ;)
     
  4. Hi PCDJoe,

    da hast Du völlig Recht. :D

    Über Einfügen->Feld->Dokument-Informationen->Eigenschaft sind die gängigsten zu erreichen.

    Alle, bei denen der Datenschutz nicht zuschlägt, sind über
    Einfügen->Feld->Dokument-Informationen->Dok-Eigenschaften->Optionen->Eigenschaft->hinzufügen->OK
    zu erreichen.

    Die wegen Datenschutz nicht auswählbaren nur per selbsteditiertem Feld:
    Einfügen->Feld->Dokument-Informationen->Dok-Eigenschaft
    {DOKEIGENSCHAFT Name \* FORMATVERBINDEN}

    Weiterhin hab ich den Makro noch bzgl. benutzerdefinierter Dokument-Eigenschaften erweitert. Verlinkung zu Textmarken wird auch ausgegeben. Die Ausgabe erfolgt jetzt in einem neuangelegten Dokument.

    Weiterhin sind folgende Beispiele angefügt:
    - MyPropertie_AddAsCustomBuildProperties
    Einfügen einer benutzerdefinierten Dokument-Eigenschaft
    - MyPropertie_InsertFieldInText
    Einfügen eines Feldes in den Text mit der benutzerdefinierten Eigenschaft.


    Gruß Matjes ;)

    Code:
    Option Explicit
    '****************************************************************
    Sub BuildinDocumentEigenschaftenAuflisten()
      Dim s_Text1 As String, s_Text2 As String
      s_Text1 = _
        Auf die Dokument-Eigenschaften kann über  & _
        Name oder Index zugegriffen werden.  & vbCrLf & _
        Dazu zwei Beispiele für den Zugriff auf->Titel': & _
        vbCrLf & vbCrLf & _
        Index:  & _
        ActiveDocument.BuiltInDocumentProperties(Title).Value & _
         = Titel über Name gesetzt & vbCrLf & _
        Name:  & _
        ActiveDocument.BuiltInDocumentProperties(1).Value & _
         = Titel über Index gesetzt & vbCrLf & vbCrLf & _
        BuildinDocumentProperties sind die fest vorgegebenen Dokument-Eigenschaften.
      
      s_Text2 = vbCrLf & vbCrLf & _
        Einfügen lassen sich die meisten Dokument-Eigenschaften über ein Feld  & vbCrLf & _
       ->Dok-Eigenschaft' + Name & vbCrLf & _
        {DOKEIGENSCHAFT Name \* FORMATVERBINDEN} & vbCrLf & _
        zu erreichen über: & vbCrLf & _
        Einfügen->Feld->Dokument-Informationen->Dok-Eigenschaften->Optionen->Eigenschaft->hinzufügen->OK & _
        vbCrLf & _
        Darüber nicht erreichbare Eigenschaften können per Makro eingefügt werden.
      Call DocumentEigenschaftenAuflisten( _
            ActiveDocument.BuiltInDocumentProperties, _
            BuildInDocumentProperties, _
            s_Text1, s_Text2)
    End Sub
    '****************************************************************
    Sub CustomDocumentEigenschaftenAuflisten()
      Dim s_Text1 As String, s_Text2 As String
      s_Text1 = _
        Auf die Dokument-Eigenschaften kann über  & _
        CustomDocumentProperties(Name) oder  & _
        CustomDocumentProperties(Index) zugegriffen werden.  & _
         (analog zu BiuldInDocumentProperties) & _
        vbCrLf & vbCrLf & _
        CustomDocumentProperties sind die selbstdefinierten  & _
        Dokument-Eigenschaften. & vbCrLf & _
        Per Add-Methode können hier Dokument-Eigenschaften hinzugefügt werden.
      
      s_Text2 = vbCrLf & vbCrLf & _
        Einfügen lassen sich die Dokument-Eigenschaften über ein Feld  & vbCrLf & _
       ->Dok-Eigenschaft' + Name & vbCrLf & _
        {DOKEIGENSCHAFT Name \* FORMATVERBINDEN} & vbCrLf & _
        zu erreichen über: & vbCrLf & _
        Einfügen->Feld->Dokument-Informationen->Dok-Eigenschaften->Optionen->Eigenschaft->hinzufügen->OK
      
      Call DocumentEigenschaftenAuflisten( _
            ActiveDocument.CustomDocumentProperties, _
            CustomDocumentProperties, _
            s_Text1, s_Text2)
    End Sub
    '****************************************************************
    Function DocumentEigenschaftenAuflisten(pl As DocumentProperties, _
                                              s_Ueberschrift As String, _
                                              s_Text1 As String, _
                                              Optional s_Text2 As String)
    
      Dim p As DocumentProperty, my_tab As Table, z As Long, l_index As Long
      
     ->Neues Dokument anlegen
     ->Documents.Add
      
     ->Seite formatieren setzen
      With ActiveDocument.PageSetup
        .Orientation = wdOrientLandscape
        .TopMargin = CentimetersToPoints(1.5)
        .BottomMargin = CentimetersToPoints(1.5)
      End With
    
     ->Schreibmarke ans Ende des Dokumentes stellen
      Selection.WholeStory
      Selection.Collapse Direction:=wdCollapseEnd
      
     ->Absatz einfügen
      With Selection
        .InsertParagraphAfter: .Collapse Direction:=wdCollapseEnd
        .Font.Bold = True: .Font.Size = 12: .Font.Name = Tahoma
        .InsertAfter s_Ueberschrift & vbCrLf
        .Collapse Direction:=wdCollapseEnd
      End With
    
      If pl.Count = 0 Then GoTo TextAusgeben
    
     ->Tabelle einfügen:
     ->Zeilen entsprechend der Anzahl Eigenschaften +1 für Überchrift
      With Selection
        .Font.Bold = False: .Font.Size = 8: .Font.Name = Tahoma
        .InsertParagraphAfter
        .Collapse Direction:=wdCollapseEnd
        .InsertParagraphAfter
        Set my_tab = ActiveDocument.Tables.Add(.Range, pl.Count + 1, 6)
      End With
        
     ->Zeilenindex auf Anfang
      z = 1
     ->Tabellen-Überschriften
      With my_tab.Cell(z, 1).Range
        .InsertAfter Name: .Font.Bold = True
      End With
      With my_tab.Cell(z, 2).Range
        .InsertAfter Index: .Font.Bold = True
      End With
      With my_tab.Cell(z, 3).Range
        .InsertAfter Value: .Font.Bold = True
      End With
      With my_tab.Cell(z, 4).Range:
        .InsertAfter mso & vbCrLf & Property & vbCrLf & Type
        .Font.Bold = True
      End With
      With my_tab.Cell(z, 5).Range:
        .InsertAfter mit & vbCrLf & Textmarke & vbCrLf & verbunden
        .Font.Bold = True
      End With
      With my_tab.Cell(z, 6).Range:
        .InsertAfter Textmarke
        .Font.Bold = True
      End With
      
     ->Zeilenindex auf nächste Zeile
      z = z + 1
     ->Name,Index und Wert der Eigenschaften in Tabelle eintragen
      l_index = 0
      For Each p In pl
        my_tab.Cell(z, 1).Range.InsertAfter p.Name
        l_index = l_index + 1
        my_tab.Cell(z, 2).Range.InsertAfter l_index
        On Error GoTo LeererWert->Fehler,wenn Value leer ist
        my_tab.Cell(z, 3).Range.InsertAfter p.Value
        On Error GoTo 0
        With my_tab.Cell(z, 4).Range
          Select Case p.Type
            Case msoPropertyTypeString: .InsertAfter String
            Case msoPropertyTypeDate: .InsertAfter Date
            Case msoPropertyTypeNumber: .InsertAfter Number
            Case msoPropertyTypeBoolean: .InsertAfter Boolean
            Case msoPropertyTypeFloat: .InsertAfter Float
            Case Else: .InsertAfter p.Type
          End Select
        End With
        With my_tab.Cell(z, 5).Range
          If p.LinkToContent Then .InsertAfter True Else .InsertAfter False
        End With
        With my_tab.Cell(z, 6).Range
          If p.LinkToContent Then .InsertAfter p.LinkSource Else .InsertAfter leer
        End With
       
       ->Zeilenindex weiterschalten
        z = z + 1
      Next
      
     ->optimale Breite der Spalten setzen
      For l_index = 1 To my_tab.Columns.Count: my_tab.Columns(l_index).AutoFit: Next
      
     ->Schreibmarke hinter die Tabelle
      my_tab.Select: Selection.Collapse Direction:=wdCollapseEnd
    
    TextAusgeben:
     ->Zusatztext ausgeben
      With Selection
        .Collapse Direction:=wdCollapseEnd
        .Font.Bold = False: .Font.Size = 8: .Font.Name = Tahoma
        .Collapse Direction:=wdCollapseEnd
        .InsertAfter vbCrLf & s_Text1
        If Not IsEmpty(s_Text2) Then
          .Collapse Direction:=wdCollapseEnd
          .InsertAfter vbCrLf & s_Text2
        End If
      End With
      
     ->Schreibmarke ans ende stellen
      Selection.Collapse Direction:=wdCollapseEnd
      
      Set my_tab = Nothing
    Exit Function
    LeererWert:
      my_tab.Cell(z, 3).Range.InsertAfter kein Wert
      Resume Next
    End Function
    '****************************************************************
    Sub DocEigenscaften_Titel_Setzen1()
      ActiveDocument.BuiltInDocumentProperties(Title).Value = _
                                            Titel über Name gesetzt
    End Sub
    '****************************************************************
    Sub DocEigenscaften_Titel_Setzen2()
      ActiveDocument.BuiltInDocumentProperties(1).Value = _
                                            Titel über Index gesetzt
    End Sub
    '****************************************************************
    Sub MyPropertie_AddAsCustomBuildProperties()
      ActiveDocument.CustomDocumentProperties.Add _
        Name:=MyPropertie, _
        LinkToContent:=False, _
        Value:=Dies ist meine neue Property, _
        Type:=msoPropertyTypeString
        
       ->das ganze mit einer Textmarke verbinden
       ->LinkToContent:=True
       ->LinkSource:= Name der Textmarke
    End Sub
    '****************************************************************
    Sub MyPropertie_InsertFieldInText()
        Selection.WholeStory
        Selection.Collapse Direction:=wdCollapseEnd
        Selection.Fields.Add _
          Range:=Selection.Range, _
          Type:=wdFieldDocProperty, _
          Text:=MyPropertie, _
          PreserveFormatting:=True
    End Sub
     
Die Seite wird geladen...

Auslesen von Datei-Eigenschaften via VBA-Script in Word - Ähnliche Themen

Forum Datum
Dateigröße auslesen mit batch programmierung Software: Empfehlungen, Gesuche & Problemlösungen 6. Feb. 2015
Win 7 Serial auslesen auf formatierter HD ? Evtl. mit Datenwiederherstellungs-Tool? Windows 7 Forum 6. Nov. 2013
[VB 2010] Nur den ersten Eintrag einer csv / txt auslesen Windows XP Forum 6. Nov. 2013
WIN7-Aktivierungskey aus Acronis-BackUp auslesen? Windows 7 Forum 7. Feb. 2012
Mit Win7 Hardwarefehler auslesen? Hardware 22. Nov. 2010