Eigenschaften auslesen und speichern

Moin Excellianer!
Ich habe in der Hilfe und im Forum zwar Antworten gefunden, aber leider reichen meine VBA-Kenntnisse noch nicht aus, sie folgendermaßen umzusetzen:
In meiner Datei habe ich im "Workbook_BeforeClose"-Ereignis eine "ActiveWorkbook.Save"-Anweisung. Bevor die Datei beim Schließen automatisch gespeichert wird, soll folgendes geschehen:

Die Eigenschaften der Datei auslesen

Diese Eigenschaften dann der Reihe nach in den Spalten eines Tabellenblattes ablegen

Jedes neue Auslesen soll immer in die erste freie Zeile geschrieben werden

Ganz wichtig wären mir folgende Datei-Eigenschaften: Erstellt, Geändert am und Letzter Zugriff
Geht das? Vielen Dank für Eure Hilfe!
Viele Grüße aus dem hohen Norden!
Lenni

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Eigenschaften() Dim Rw As Integer Dim P Rw = 1 On Error Resume Next For Each P In ActiveWorkbook.BuiltinDocumentProperties Cells(Rw, 1).Value = P.Name Cells(Rw, 3) = P.Value Rw = Rw + 1 Next End Sub

Option Explicit Sub Eigenschaften2() Dim lngZ As Long, lngC As Long, objP As DocumentProperty ' ----------------- nur für die Eigenschaft-Namen in Zeile 1 - kann evtl. entfallen If IsEmpty(Cells(1, 1)) Then For Each objP In ActiveWorkbook.BuiltinDocumentProperties lngC = lngC + 1 Cells(1, lngC).Value = objP.Name Next lngC = 0 End If ' ----------------- ab hier Ausgabe der Werte der Dok-Eigenschaften lngZ = Cells(Rows.Count, 3).End(xlUp).Row + 1 On Error Resume Next For Each objP In ActiveWorkbook.BuiltinDocumentProperties lngC = lngC + 1 Cells(lngZ, lngC).Value = objP.Value Next On Error GoTo 0 End Sub

Hi Lenni,
meinst du das so?


Option Explicit
Sub Eigenschaften3()
Dim lngZ As Long, lngC As Long, objP As DocumentProperty
With Worksheets("Eigenschaften")    ' Ausgabeblatt - hier festlegen
' ----------------- nur für die Eigenschaft-Namen in Zeile 1 - kann evtl. entfallen
If IsEmpty(.Cells(1, 1)) Then
For Each objP In ActiveWorkbook.BuiltinDocumentProperties
lngC = lngC + 1
.Cells(1, lngC).Value = objP.Name
Next
lngC = 0
End If
' ----------------- ab hier Ausgabe der Werte der Dok-Eigenschaften
lngZ = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
'   On Error Resume Next
For Each objP In ActiveWorkbook.BuiltinDocumentProperties
lngC = lngC + 1
On Error Resume Next
.Cells(lngZ, lngC).Value = objP.Value
Next
On Error GoTo 0
.Cells(1, 1).Resize(, lngC).EntireColumn.AutoFit
End With
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

Eigenschaften auslesen und speichern

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread