Dateien per VBA auslesen

F. · 2019-01-30T01:45:29+00:00

Hallo zusammen! Um eine größere Menge an Filmen und Musik Dateien in Excel zu archivieren möchte ich diese mit VBA mit den gebräuchlichsten Eigenschaften von der Festplatte auslesen und in einer Excel Tabelle abspeichern. Ich habe zwar ein VBA Makro, das aber nur die einfachsten Eigenschaften wie: "Pfad, Name, Ordner, Datum / Uhrzeit, Größe, Erstelldatum / Uhrzeit, Änderungsdatum / Uhrzeit" mir ausgibt. Gerade für die Filme und die Musik Dateien wäre es aber natürlich vorteilhafter, wenn man da auch die Länge der Spiel- bzw. Laufzeit mit auslesen und dazu abspeichern könnte. Ideal wäre natürlich noch, wenn man das Makro dann je nach Bedarf mit den gebräuchlichsten Eigenschaften so nach und nach ergänzen könnte. Ich suche schon mehrere Stunden nach einer geeigneten Lösung, bin aber eher am verzweifeln und wie üblich seid Ihr im Forum wieder mal meine letzte Rettung. Hier im Forumsarchiv habe ich zwar vieles gesehen, aber das geeignete war für mich nicht dabei. Außer einem Makro "Dateieigenschaften() 'von k.rola". Aber da sind alle Dateieigenschaften vorhanden, die im Explorer zur Verfügung stehen, das ist wieder zu viel des Guten. Also, vorab schon einmal vielen Dank für Euere Hilfe. Viele Grüße Frieder

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

Forumthread: Dateien per VBA auslesen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial