HERBERS Excel-Forum - VBA-Basics

Thema: Dateieigenschaften

Inhaltsverzeichnis
  • 1 Über Dateieigenschaften
  • 2 Programmierbeispiele
  • Ü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