Problemstellung:
Nur für 32Bit Office Versionen
Ist es unter MS-Access möglich die EXIF-Tags von Bilddateien zu lesen, verändern bzw. zu löschen?
Die Lösung entstand aufgrund zweier Anfragen.
In der ersten ging es um das Auslesen und zurüch schreiben der EXIF-Tags und in der zweiten um
das ändern des Dateidatum zum Aufnahmedatum aus den EXIF-Tags.
Voraussetzungen:
Das Bsp. ist ab A2000 lauffähig.
Im Modul "mod_GDI" sind nicht alle EXIF-Tags enthalten da diese auch stark Kameraspezifisch je nach Hersteller sind.
Infos zu GDI+ Library bei MS
Weitere Infos gibt es hier: EXIF-Tags
Lösung:
Im Vorfeld habe ich einige Lösungen getestet. Zum Schluss habe ich mich für die Lösung mittels der GDI+ Library entschieden.
Diese bot für meine Zwecke die beste Umsetzung.
Bei der Benutzung der GDI+ Library ist diese beim Start des Forms zu initialisieren und beim Beenden zu deinitialisieren
Private Sub Form_Load() GdipInitialized = False ' GDI+ initialisieren If Execute(StartUpGDIPlus(GdiplusVersion)) = OK Then GdipInitialized = True Else MsgBox "GDI+ not inizialized.", vbOKOnly, "GDI Error" End If End Sub Private Sub Form_Unload(Cancel As Integer) If GdipInitialized = True Then ' ist ein Bitmapobjekt vorhanden, dann lösche das Bitmapobjekt If lngBitmap Then If Execute(GdipDisposeImage(lngBitmap)) = OK Then lngBitmap = 0 End If ' GDI+ beenden Call Execute(ShutdownGDIPlus) End If End Sub
1. EXIF-Daten eines Verzeichnisses (mit/ ohne Unterverzeichnissen)
Im 1. Teil sollen alle Dateien eines Verzeichnisses (mit/ ohne Unterverzeichnissen) eingelesen werden und nach einem
Klick auf die Datei die EXIF-Tags angezeigt werden. Dann können diese verändert oder gelöscht werden.
Zuerst werden alle betreffenden Dateien ermittelt (Filter, Unterverzeichnisse ja/nein) und in eine Collection geschrieben (s. Klassenmodul "cls_ListFiles")
Die Collection wird dann in die Tabelle "tbl_Files" geschrieben.
Wird dann eine Datei im Listenfeld angeklickt werden im unteren Listview die vorhandenen EXIF-Tags angezeigt.
Diese werden durch die Sub "LoadMetaData" ermittelt:
Private Sub LoadMetaData() Dim objListView As ListView Dim objListItem As ListItem Dim propCount As Long Dim propList() As Long Dim tAllProps As ALLPROPS Set objListView = Me.lst_EXIF.Object Me.lst_EXIF.ListItems.Clear Me.lst_EXIF.Refresh ' Anzahl der Metatags ermitteln If GetPropertyCount(lngBitmap, propCount) = OK Then lblLngPropertyCount.Caption = "Anzahl der EXIF-Einträge: " & propCount ' sind Metatags vorhanden If (propCount > 0) Then ' Array dimensionieren das die Liste der Metatags ' aufnehmen soll ReDim propList(propCount - 1) ' Liste der Metatags auslesen -> propList() If GetPropertyIdList(lngBitmap, propCount, propList()) = OK Then ' Liste der Metatags in die ListBox For z = 0 To propCount - 1 ' Metatag als String in der Listbox tAllProps = ReadAllProperties(lngBitmap, propList(z)) Set objListItem = objListView.ListItems.Add(, "a" & z, PropertyIDToString(propList(z))) With objListItem .ListSubItems.Add , , tAllProps.vSize .ListSubItems.Add , , tAllProps.vHexID .ListSubItems.Add , , tAllProps.vType .ListSubItems.Add , , tAllProps.vPropType .ListSubItems.Add , , tAllProps.vPropValue .ListSubItems.Add , , tAllProps.vValue End With Next z Erase propList End If End If End If End Sub
Wird jetzt ein Tag-Eintrag angeklickt werden die Werte in den unteren Textfeldern eingefügt.
Die Felder "Tagname" und "TagID" können nicht geändert werden.
Außer bei den Datentypen "Rational" und "SRational" werden die jeweiligen Werte im Feld gändert werden.
Die beiden anderen Typen sind als Brüche dargestellt (z.B. 56/10). Deshalb sind dann beide Felder aktiviert.
Es geht nicht das der Bruch nur in eins der beiden Feldern eingetragen wird.
Jetzt besteht die Möglichkeit den geänderten EXIF-Tag zu speichern (Button "EXIF-Tag speichern"):
Private Sub cmd_Save_Click() Dim nResult As Status Dim tempFileName As String Select Case nSelectTagType Case 1 nResult = SetPropertyItemByte(lngBitmap, CLng(Left(Me.txt_TagID, Len(Me.txt_TagID) - 1)), CByte(Me.txt_Value)) Case 2 nResult = SetPropertyItemAscii(lngBitmap, CLng(Left(Me.txt_TagID, Len(Me.txt_TagID) - 1)), Me.txt_Value) Case 3 nResult = SetPropertyItemShort(lngBitmap, CLng(Left(Me.txt_TagID, Len(Me.txt_TagID) - 1)), CInt(Me.txt_Value)) Case 4, 9 nResult = SetPropertyItemLong(lngBitmap, CLng(Left(Me.txt_TagID, Len(Me.txt_TagID) - 1)), nSelectTagType, CLng(Me.txt_Value)) Case 5, 10 nResult = SetPropertyItemRational(lngBitmap, CLng(Left(Me.txt_TagID, Len(Me.txt_TagID) - 1)), nSelectTagType, CLng(Me.txt_Value), CLng(Me.txt_Denominator)) Case 7 nResult = SetPropertyItemUndefined(lngBitmap, CLng(Left(Me.txt_TagID, Len(Me.txt_TagID) - 1)), Me.txt_Value) Case Else MsgBox "Typ nicht klassizifiert!", vbCritical + vbOKOnly, "Fehler" Exit Sub End Select If nResult <> 0 Then Exit Sub Else tempFileName = sFilePath & "_" If SaveAsJPG(tempFileName) = True Then If Execute(GdipDisposeImage(lngBitmap)) = OK Then lngBitmap = 0 Kill sFilePath Name tempFileName As sFilePath End If End If End If End Sub
Oder den EXIF-Tag zu löschen (Button "EXIF-Tag Löschen"):
Private Sub cmd_Delete_Click() Dim nResult As Long Dim tempFileName As String nResult = RemovePropertyItem(lngBitmap, CLng(Left(Me.txt_TagID, Len(Me.txt_TagID) - 1))) If nResult <> 0 Then Exit Sub Else tempFileName = sFilePath & "_" If SaveAsJPG(tempFileName) = True Then If Execute(GdipDisposeImage(lngBitmap)) = OK Then lngBitmap = 0 Kill sFilePath Name tempFileName As sFilePath End If End If End If End Sub
2. Dateien einlesen, EXIF-Tag "DateTime" einlesen und in allen Dateien die Attribute "Erstellt am" und "zuletzt geändert am" auf den EXIF-Tag "DateTime" setzen.
Dafür bitte das Form "frm_Start2" aufrufen.
Auch hier werden erstmal die betreffenden Dateien in eine Collection geladen (s. Punkt 1)
Einziger Unterschied besteht darin das die Dateien nicht in der Tabelle gespeichert werden.
Private Sub cmd_Folder_Click() Dim sFolder As String Dim sFilter As String Dim x Dim i As Long Dim sDateTime As String, dtDateTime As Date On Error GoTo cmd_Folder_Click_Error 'Verzeichnis Öffnen Dialog sFolder = GetDirectory("Bitte wählen Sie einen Ordner") If IsNull(sFolder) Or sFolder = "" Then Exit Sub If IsNull(Me.txt_Filter) Then sFilter = "*.*" Else sFilter = Me.txt_Filter End If 'Collection mit dem Ergebnis füllen x = cLFs2.ListFiles(sFolder, sFilter, Me.chk_SubFolder) Me.lbl_CountFiles.Caption = cLFs2.Col_File.Count & " Dateien nach den Kriterien gefunden" For i = 1 To cLFs2.Col_File.Count 'Bild in GDI+ laden If LoadPicturePlus(cLFs2.Col_File(i)) = OK Then If lngBitmap Then 'Lesen des Tags "DateTime" (Hex &H132) sDateTime = ReadGDI(lngBitmap, &H132) 'Umwandeln des Tags da dieser im Format "YYYY:MM:TT HH:NN:SS" vorliegt dtDateTime = CDate(ChangeFormat(sDateTime)) 'GDI+ Bitmap schliessen If Execute(GdipDisposeImage(lngBitmap)) = OK Then lngBitmap = 0 'Setzten der Attribute "Erstellt am" und "Zuletzt geändert am" Call SetTimeStamp(cLFs2.Col_File(i), dtDateTime, dtDateTime) End If End If End If Next i On Error GoTo 0 Exit Sub cmd_Folder_Click_Error: Resume Next End Sub
Nur für 32Bit Office Versionen
Arbeiten mit EXIF-Tags und der GDI+ Library
ab A00
Die ZIP-Datei enthält eine Version ab A2000
Ähnliche Artikel
Weiterlesen...