05.02.2025, 14:32
Liebe Leserin, lieber Leser,
zum Auslesen diverser Dateieigenschaften von Mediendateien wird oft GetDetailsOf verwendet.
Hier mal eine weitere Möglichkeit, sich diese Daten anzeigen zu lassen.
Die Sub listet alle gefundene Eigenschaften mit Name und Wert auf.
Die Funktion zeigt, wie man ohne Schleife auf eine Einzeleigenschaft, hier Aufnahmedatum, zugreifen kann.
zum Auslesen diverser Dateieigenschaften von Mediendateien wird oft GetDetailsOf verwendet.
Hier mal eine weitere Möglichkeit, sich diese Daten anzeigen zu lassen.
Die Sub listet alle gefundene Eigenschaften mit Name und Wert auf.
Die Funktion zeigt, wie man ohne Schleife auf eine Einzeleigenschaft, hier Aufnahmedatum, zugreifen kann.
Code:
Function Aufnahmedatum(sDatei As String) As Variant
' Function gibt das Aufnahmedatum eines Fotos zurück
On Error Resume Next
With CreateObject("WIA.ImageFile")
.LoadFile (sDatei)
If Err.Number <> 0 Then
Aufnahmedatum = "Die Datei" & vbLf & sDatei & vbLf _
& "wurde nicht gefunden!"
Else
Aufnahmedatum = "Kein Aufnahmedatum vorhanden!"
Aufnahmedatum = CDate(Replace(.Properties("ExifDTDigitized").Value, ":", "/", 1, 2))
End If
End With
End Function
Sub ErmittleDateieigenschaften(sDatei As String)
' Funktion listet alle EXIF-Dateieigenschaften der Datei auf
Dim oProp As Object, L As Long
Const Lz As String = " "
On Error Resume Next
With CreateObject("WIA.ImageFile")
.LoadFile (sDatei)
If Err.Number <> 0 Then
MsgBox "Die Datei" & vbLf & sDatei & vbLf & "wurde nicht gefunden!", _
vbCritical, "EXIF-Daten ermitteln"
Exit Sub
End If
For Each oProp In .Properties
With oProp
L = Len(.Name)
If L > 5 Then
Debug.Print Left$(.Name & Lz & Lz, 25) & .Value
End If
End With
Next oProp
End With
End Sub
Sub Test()
ErmittleDateieigenschaften "D:\Pictures\Fotos\PICT0010.JPG"
MsgBox Aufnahmedatum("D:\Pictures\Fotos\PICT0010.JPG")
End Sub
' Function gibt das Aufnahmedatum eines Fotos zurück
On Error Resume Next
With CreateObject("WIA.ImageFile")
.LoadFile (sDatei)
If Err.Number <> 0 Then
Aufnahmedatum = "Die Datei" & vbLf & sDatei & vbLf _
& "wurde nicht gefunden!"
Else
Aufnahmedatum = "Kein Aufnahmedatum vorhanden!"
Aufnahmedatum = CDate(Replace(.Properties("ExifDTDigitized").Value, ":", "/", 1, 2))
End If
End With
End Function
Sub ErmittleDateieigenschaften(sDatei As String)
' Funktion listet alle EXIF-Dateieigenschaften der Datei auf
Dim oProp As Object, L As Long
Const Lz As String = " "
On Error Resume Next
With CreateObject("WIA.ImageFile")
.LoadFile (sDatei)
If Err.Number <> 0 Then
MsgBox "Die Datei" & vbLf & sDatei & vbLf & "wurde nicht gefunden!", _
vbCritical, "EXIF-Daten ermitteln"
Exit Sub
End If
For Each oProp In .Properties
With oProp
L = Len(.Name)
If L > 5 Then
Debug.Print Left$(.Name & Lz & Lz, 25) & .Value
End If
End With
Next oProp
End With
End Sub
Sub Test()
ErmittleDateieigenschaften "D:\Pictures\Fotos\PICT0010.JPG"
MsgBox Aufnahmedatum("D:\Pictures\Fotos\PICT0010.JPG")
End Sub
_________
viele Grüße
Karl-Heinz
viele Grüße
Karl-Heinz