VBA in Excel/ Dateieigenschaften

| Hoch zu „Inhaltsverzeichnis“ |

Über Dateieigenschaften

Über VBA-Prozeduren können Dateieigenschaften gelesen und geschrieben werden. Voraussetzung hierfür ist, dass das jeweilige Dokument geöffnet ist.

Programmierbeispiele

Dateieigenschaften lesen

• Prozedur: ReadDocumentProperties
• Art: Sub
• Modul: Standardmodul
• Zweck: Dateieigenschaften in eine Tabelle einlesen
• Ablaufbeschreibung:
  • Variablendeklaration
  • Datenbereich leeren
  • Fehlerroutine starten
  • Rahmen um die BuiltInDocumentProperties bilden
  • Schleife über alle Elemente bilden
  • Den Namen der Eigenschaft eintragen
  • Den Wert der Eigenschaft eintragen
  • Den Typ der Eigenschaft eintragen
  • Wenn ein Fehler aufgetreten ist...
  • Den Fehlerwert eintragen
  • Fehler-Objekt zurücksetzen
  • Rahmen um die CustomDocumentProperties bilden
  • Schleife über alle Elemente bilden
  • Den Namen der Eigenschaft eintragen
  • Den Wert der Eigenschaft eintragen
  • Den Typ der Eigenschaft eintragen
  • Wenn ein Fehler aufgetreten ist...
  • Den Fehlerwert eintragen
  • Fehler-Objekt zurücksetzen
• Code:

Sub ReadDocumentProperties()
   Dim iRow As Integer
   Range("A4:F35").ClearContents
   On Error Resume Next
   With ActiveWorkbook.BuiltinDocumentProperties
      For iRow = 1 To .Count
         Cells(iRow + 3, 1).Value = .Item(iRow).Name
         Cells(iRow + 3, 2).Value = .Item(iRow).Value
         Cells(iRow + 3, 3).Value = .Item(iRow).Type
         If Err.Number <> 0 Then
            Cells(iRow + 3, 2).Value = CVErr(xlErrNA)
            Err.Clear
         End If
      Next iRow
   End With
   With ActiveWorkbook.CustomDocumentProperties
      For iRow = 1 To .Count
         Cells(iRow + 3, 5).Value = .Item(iRow).Name
         Cells(iRow + 3, 6).Value = .Item(iRow).Value
         Cells(iRow + 3, 7).Value = .Item(iRow).Type
         If Err.Number <> 0 Then
            Cells(iRow + 3, 6).Value = CVErr(xlErrNA)
            Err.Clear
         End If
      Next iRow
   End With
   On Error GoTo 0
End Sub

Dateieigenschaften schreiben

• Prozedur: WriteDocumentProperties
• Art: Sub
• Modul: Standardmodul
• Zweck: Dateieigenschaften in eine Datei schreiben
• Ablaufbeschreibung:
  • Variablendeklaration
  • Aktives Blatt an eine Objekt-Variable übergeben
  • Wenn die Zelle A4 leer ist...
  • Warnton
  • Warnmeldung
  • Prozedur verlassen
  • Neue Arbeitsmappe anlegen
  • Rahmen um die BuiltInDocumentProperties bilden
  • Eine Schleife um den Datenbereich bilden
  • Wenn die Zelle in Spalte A der aktuellen Zeile leer ist, Prozedur verlassen
  • Wenn sich in Spalte B der aktuellen Zeile kein Fehlerwert befindet...
  • Wert für die Dateieigenschaft gem. Spalte A der aktuellen Zeile festlegen
  • Rahmen um die CustomDocumentProperties bilden
  • Eine Schleife um den Datenbereich bilden
  • Eine benutzerdefinierte Eigenschaft hinzufügen
  • Vollzugsmeldung anzeigen
• Code:

Sub WriteDocumentProperties()
   Dim wks As Worksheet
   Dim iRow As Integer
   Set wks = ActiveSheet
   If IsEmpty(Range("A4")) Then
      Beep
      MsgBox "Sie müssen zuerst die Eigenschaften einlesen!"
      Exit Sub
   End If
   Workbooks.Add
   With ActiveWorkbook.BuiltinDocumentProperties
      For iRow = 4 To 35
         If IsEmpty(wks.Cells(iRow, 1)) Then Exit For
         If IsError(wks.Cells(iRow, 2)) = False Then
            .Item(wks.Cells(iRow, 1).Value) = wks.Cells(iRow, 2).Value
         End If
      Next iRow
   End With
   With ActiveWorkbook.CustomDocumentProperties
      For iRow = 4 To 4
         .Add Name:=wks.Cells(iRow, 5).Value, LinkToContent:=False, _
            Type:=msoPropertyTypeDate, Value:=wks.Cells(iRow, 6).Value
      Next iRow
   End With
   MsgBox "Die editierbaren Dateieigenschaften wurden auf diese neue" & vbLf & _
      "Arbeitsmappe übertragen, bitte prüfen."
End Sub

Alle Dateieigenschaften ausgeben

Dateieigenschaften können eingebaute Dateieigenschaften sein (Auflistung der .BuiltinDocumentProperties), aber auch benutzerdefinierte Eigenschaften sein (Auflistung der .CustomDocumentProperties), die beispielsweise von anderen Programmen (wie NovaPath) geschrieben werden. Das folgende Programmierbeispiel zeigt, wie man im Hauptprogramm die gewünschte Auflistung als Objekt an das Unterprogramm übergeben wird. Im Unterprogramm wiederum werden alle Dateieigenschaften überprüft und ausgegeben, wenn vorhanden. Dieser Aufbau bietet sich an, weil beide Eigenschaftstypen über gleiche Methoden und Eigenschaften verfügen. Das Programm ermittelt alle Eigenschaften der aktiven Arbeitsmappe und gibt sie auf ein neues Blatt aus, welches dieser Arbeitsmappe angefügt wird.

Die Switch-Anweisung ist die einzeilige Version der Select-Case-Anweisung.

' Listet alle Deteieigenschaften der aktiven Arbeitsmappe auf
Public Sub DateiEigenschaftenAufzählen()
    ' Mappe, deren Eigenschaften ermittelt werden
    Dim Mappe           As Excel.Workbook
    
    ' Neues Blatt mit der Liste aller Eigenschaften
    Dim AusgabeBlatt    As Excel.Worksheet
    
    ' Zeile in der Ausgabemappe, in die gerade geschrieben wird
    Dim AusgabeZeileNr  As Long
    
    On Error Resume Next
    
    Set Mappe = ActiveWorkbook
    Set AusgabeBlatt = Mappe.Worksheets.Add
    
    AusgabeZeileNr = 2
    ' Eingebaute Eigenschaften auflisten
    EigenschaftenAusgeben Mappe.BuiltinDocumentProperties, _
        AusgabeBlatt, AusgabeZeileNr, "B"
    
    ' Benutzerdefinierte Eigenschaften auflisten
    EigenschaftenAusgeben Mappe.CustomDocumentProperties, _
        AusgabeBlatt, AusgabeZeileNr, "C"
    
    ' Kopfzeile der Ausgabetabelle formatieren
    With AusgabeBlatt.Range("A1:E1")
        .Value = Array("Typ", "ID", "Name", "Wert", "Datentyp")
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .EntireColumn.AutoFit
        .AutoFilter
        ' Blattname ändern:
        .Parent.Name = "DateiEigenschaften"
    End With
    
End Sub

Private Sub EigenschaftenAusgeben(EigenschaftsListe As Object, _
    AusgabeBlatt As Worksheet, ByRef AusgabeZeileNr As Long, Eingebaut As String)
    
    ' Zählvariable
    Dim EigenschaftsID  As Long
    
    On Error Resume Next
    
    ' Alle Eigenschaften durchgehen
    For EigenschaftsID = 1 To EigenschaftsListe.Count
        With EigenschaftsListe(EigenschaftsID)
            If .Name <> vbNullString Then ' Eigenschaft vorhanden
                AusgabeBlatt.Cells(AusgabeZeileNr, 1).Value = Eingebaut
                AusgabeBlatt.Cells(AusgabeZeileNr, 2).Value = EigenschaftsID
                AusgabeBlatt.Cells(AusgabeZeileNr, 3).Value = .Name
                AusgabeBlatt.Cells(AusgabeZeileNr, 4).Value = .Value
                
                ' Datentyp in Text übersetzen
                AusgabeBlatt.Cells(AusgabeZeileNr, 5).Value = Switch(.Type = _
                            msoPropertyTypeDate, "Datum", _
                    .Type = msoPropertyTypeBoolean, "Boolscher Wert", _
                    .Type = msoPropertyTypeNumber, "Ganzzahl", _
                    .Type = msoPropertyTypeString, "Text", _
                    .Type = msoPropertyTypeFloat, "Gleitkommazahl")
                
                ' Nächste Zeile im Ausgabeblatt
                AusgabeZeileNr = AusgabeZeileNr + 1
            End If
        End With
    Next EigenschaftsID
End Sub

| Hoch zu „Inhaltsverzeichnis“ |