1 1 1 1 1 1 1 1 1 1 Rating 5.00 (1 Vote)

Problemstellung:
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.

exif1

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

 

Dateien:

Arbeiten mit EXIF-Tags und der GDI+ Library

ab A00

Die ZIP-Datei enthält eine Version ab A2000

 
Datum 05.02.2018
Dateigröße 77.94 KB
Download 617

Ähnliche Artikel

Kommentar schreiben

Sicherheitscode
Aktualisieren

Login Form

Neueste Artikel

Problemstellung: Ab MS-Office 2010 gibt es eine 32bit und eine 64bit Variante.Übernimmt man nun eine Datenbank nach 64bit und diese enthält API-Declare Anweisungenerhlt min in der Regel diese...
1.png2.png0.png4.png8.png8.png2.png
Heute60
Gestern96
Diese Woche60
Dieser Monat2306
Total1204882

  • IP: 54.198.205.153
  • Browser: Unknown
  • Version:
  • OS: Unknown

Online

3
Online

24. September 2018

Letzte Kommentare

  • Trusted Locations Manager

    Tommy Admin 13.07.2018 13:06
    RE: Trusted Locations Manager
    Hallo Matthias, aus Ermangelung einer 64bit Version kann ich das leider nicht prüfen. Tut mir leid. Gruss ...

    Weiterlesen...

     
  • Trusted Locations Manager

    Matthias 13.07.2018 06:48
    Funktioniert nicht
    Habe gerade den TL-Manager installiert. Nach dem Start sagt er mir, dass es kein Office erkennen ...

    Weiterlesen...