Dateien per VBA auslesen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub DateiattributLesen() Dim shell As Object Dim DatVerzeichnis As Object Dim DatAuswahl As Object Dim DatAttribut As Integer 'Windows Shell Objekt Set shell = CreateObject("Shell.Application") 'Auswahl des Dateiattributes (0-33) DatAttribut = 1 ' 'Dateipfad angeben Set DatVerzeichnis = shell.Namespace("H:\") 'Datei angeben Set DatAuswahl = DatVerzeichnis.ParseName("inhalt.pdf") ' File Item (Datei) Debug.Print DatAttribut & " - " & DatVerzeichnis.GetDetailsOf(Null, DatAttribut) & ": " & _ DatVerzeichnis.GetDetailsOf(DatAuswahl, DatAttribut) End Sub

Hallo Frieder,
man kann es dann wie folgt umsetzen, wenn nur bestimmte Eigenschaften angezeigt werden sollen.
LG
Franz


Sub Dateieigenschaften_alle()
Call Dateieigenschaften_0_bis_33("C:\Users\public\Documents", NrIndex:=True)
End Sub
Sub Dateiegen_schaften_medien()
Call Dateieigenschaften_0_bis_33("C:\Users\public\Documents", _
varEigenschaften:=Array(0, 3, 12, 13, 14, 15, 16, 17, 18), NrIndex:=False)
End Sub
Sub Dateieigenschaften_0_bis_33(ByVal STRFOLDER As Variant, Optional varEigenschaften As  _
Variant, _
Optional NrIndex As Boolean = False)
'STRFOLDER:  Ordner in dem die Eigenschaften der Dateien  ausgelesen werden sollen
'varEigenschaften: Array mit den Index-Nummern der Eigenschaften, die ausgelesen werden sollen
'wird der parameter weggelassen, werden alle Eigenschaften ausgelesen
'NrIndex: optional, wenn True, dann werden in Zeile 1 die Index-Nrn der Eigenschaften  _
ausgegeben
Dim objShell As Object, objFolder As Object
Dim x As Byte, intColumn As Integer, lngRow As Long
Dim varName, arrHeaders(34)
Dim varWert
If Dir(STRFOLDER, 16) = "" Then
MsgBox "Der Ordner " & STRFOLDER & " wurde nicht gefunden!" & Space(10), 64, "weise hin... _
Exit Sub
End If
On Error Resume Next
ActiveSheet.UsedRange.Clear
Application.ScreenUpdating = False
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(STRFOLDER)
intColumn = 0
'Index-Nummer und Namen der Dateieigenschaften
For x = 0 To 33
If fncCheck(IIf(VBA.IsMissing(varEigenschaften), -1, x), varEigenschaften) Then
intColumn = intColumn + 1
arrHeaders(x) = objFolder.GetDetailsOf(varName, x)
If NrIndex = True Then
Cells(1, intColumn) = x
Cells(2, intColumn) = arrHeaders(x)
Else
Cells(1, intColumn) = arrHeaders(x)
End If
End If
Next
If NrIndex = True Then
Rows(2).Font.Bold = True
lngRow = 3
Else
Rows(1).Font.Bold = True
lngRow = 2
End If
For Each varName In objFolder.Items
intColumn = 0
For x = 0 To 33
If fncCheck(IIf(IsMissing(varEigenschaften), -1, x), varEigenschaften) Then
intColumn = intColumn + 1
varWert = ""
varWert = objFolder.GetDetailsOf(varName, x)
Select Case x
Case 3, 4, 5 'Datum Zeit
If IsDate(varWert) Then varWert = CDate(varWert)
Case 12 'Aufnahmedatum (enthält sonderzeichen deshalb keine echtes Exceldatum
If IsDate(varWert) Then
varWert = CDate(varWert)
End If
Case Else
End Select
Cells(lngRow, intColumn) = varWert
End If
Next
lngRow = lngRow + 1
Next
Columns.AutoFit
Application.ScreenUpdating = True
End Sub
Private Function fncCheck(ByVal x As Integer, Optional varWerte) As Boolean
Dim intJ As Integer
fncCheck = False
If x

Hallo Franz,
zuerst wieder mal recht herzlichen Dank für Deinen Einsatz. Mittlerweile nähern wir uns solangsam der "Eier legenden Wollmilchsau" an. Es sind noch ein paar Kleinigkeiten die noch zum "großen Wurf" fehlen und das wären die Anzeige des Laufwerk & Pfad Namen in der ersten Zeile, von dem die Ordner aus gelesen werden. Könnte man ja von der Verzeichnis Auswahl mit über nehmen (z. B. Pfad: d:\Filme\). Momentan bleibt ja der Unterverzeichnis-Ordner leer (es wird kein Laufwerk / Pfad angezeigt) wenn Ordner leer, oder auch Dateien darin vorhanden sind. Erst nach dem ersten Unterverzeichnis-Ordner wird der Name des selbigen angezeigt. Schön wäre es, wenn der komplette Pfadname angezeigt werden würde (d:\Filme\ etc.). Wegen der Übersichtlichkeit hätte ich auch noch einen Wunsch und zwar wenn man zwischen jeder Spalte eine Spalte mit "0,5" Breite einfügen könnte, würde das dann alles etwas übersichtlicher machen. Zu guter Letzt gäbe es noch eine Art von "Favoriten-Auswahl" der aufgerufenen Verzeichnisse / Ordner, so dass man direkt von dort seine Auswahl treffen könnte. Nur wenn der Aufwand nicht zu groß ist und sich so was überhaupt in so einem Projekt realisieren lässt. Soweit habe ich glaube ich momentan alles zusammen geschrieben, was es noch zu ändern gebe. Aber ein altes Programmierer Sprichwort heißt ja: "Ein Programm ist erst perfekt, wenn man es nicht mehr braucht". In diesem Sinne ... Vielen Dank im voraus ...
Viele Grüße
Frieder

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

10 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Dateien per VBA auslesen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

10 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread