Dateieigenschaften einzeln anzeigen

Sub DokumenteigenschaftenAuflisten() Dim Zeile As Integer Dim Dp As DocumentProperty Worksheets.Add before:=Worksheets(1) Zeile = 1 On Error Resume Next For Each Dp In ActiveWorkbook.BuiltinDocumentProperties Cells(Zeile, 1) = Dp.Name Cells(Zeile, 2) = Dp.Value Zeile = Zeile + 1 Next Dp On Error GoTo 0 End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub mails_Eigenschaften_listen() Set MyOutApp = CreateObject("Outlook.Application") Set MyOlExp = MyOutApp.ActiveExplorer Set myOlSel = MyOlExp.Selection On Error Resume Next Cells.Clear With myOlSel(1) For i = 0 To .itemproperties.Count 'Debug.Print i, .itemproperties.Item(i).Name, Left(.itemproperties.Item(i).value, 50) Cells(i + 2, 1) = i Cells(i + 2, 2) = .itemproperties.Item(i).Name Cells(i + 2, 3) = Left(.itemproperties.Item(i).value, 50) Next i End With End Sub

Hallo bin neu in Excel und VBA, ich versuch mal eine Interpretation
Set MyOutApp = CreateObject("Outlook.Application") Outlook-Objekt erstellen
Set MyOlExp = MyOutApp.ActiveExplorer ?
Set myOlSel = MyOlExp.Selection ?
On Error Resume Next Bei Fehler auf zum Nächsten
Cells.Clear Zellen leeren
With myOlSel(1) ?
For i = 0 To .itemproperties.Count Schleife für Eigenschaftenzähler
'Debug.Print i, .itemproperties.Item(i).Name, Left(.itemproperties.Item(i).value, 50) Debug-Routine
Cells(i + 2, 1) = i Zähler höher setzen (lfd. Nr. einer Zeile)
Cells(i + 2, 2) = .itemproperties.Item(i).Name Eigenschaft gemäß Zähler nennen (Application, Class, ...)
Cells(i + 2, 3) = Left(.itemproperties.Item(i).value, 50) Linksbündig den Ausgabewert in die danebenstehende Spalte schreiben
Next i nächstes i
End With
1. Problem: Ist Outlook geschlossen liefert die Routine einen Fehler. Liegt wohl am Aufruf von Outlook. Schreibe ich die Routine um auf "Excel.Application" und ändere "MyOutApp" in "MyExl.App" gibt es einen Fehler.
2. Verwende ich nur die For-Next-Schleife kennt er ".itemproperties.count" nicht. Setze ich das um auf "FSO.itemproperties.count" kennt er den Wert ebenfalls nicht.
Meinen gesamten Code den ich mir zusammengesucht habe (Von mir stammen nur die Positionierungen und die Spaltenüberschriften - also das "hübsch" machen.) im nächsten Beitrag.

Option Explicit


Private Sub Schaltfläche1_Klicken()
'Variablendeklaration
Dim FolderPath As String
Dim r As Long
'Update Bildschirmanzeige ausschalten
Application.ScreenUpdating = False
'Dateipfad holen
FolderPath = Tabelle1.Cells(3, 9).Value
ActiveSheet.Activate
'Inhalt leeren
Range("A2:F20").Select
Selection.ClearContents
'Überschriften definieren
Range("A1").Formula = "Name:"
Range("B1").Formula = "Pfad:"
Range("C1").Formula = "Größe:"
Range("D1").Formula = "Datum erstellt:"
Range("E1").Formula = "Autor:"
Range("F1").Formula = "Category:"
'Überschriften formatieren
Range("A1:F1").Font.Bold = True
'Informationen abrufen
Range("A2").Select
ListFilesInFolder FolderPath, True
'Spaltenbreite automatisch einstellen
Columns("A:F").Select
Selection.Columns.AutoFit
Range("A2").Select
MsgBox "Fertig!", vbOKOnly, "Meldung"
End Sub

Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
'DokuBiblio V0.8, 11.03.2022, TB
'Variablendeklaration
Dim FSO As Object
Dim SourceFolder As Object
Dim SubFolder As Object
Dim FileItem As Object
Dim Author As String
Dim Keywords As String
Dim Category As String
Dim objInfo As Object
Dim objFolder As Object
Dim objFolderItem As String
objFolderItem = 4
Dim r As Long
Dim objFilePropReader As Object
Dim objDocProp As Object
Dim lngRow As Long
Dim i As Integer
'Erstellung FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
'Einstellung der Eigenschaften
Cells(r, 1).Formula = FileItem.Name
Cells(r, 2).Formula = FileItem.Path
Cells(r, 3).Formula = FileItem.Size
Cells(r, 4).Formula = FileItem.datecreated
'Cells(r, 5).Formula = .Category
'Cells(r, 6).Formula = FileItem.Category
r = r + 1
Next FileItem
'Unterordner holen
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub

Beliebteste Forumthreads (12 Monate)

Dateieigenschaften einzeln anzeigen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread