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

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.

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:

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

 
Datum 05.02.2018
Dateigröße 77.94 KB
Download 991

 

Ähnliche Artikel

You have no rights to post comments

Login Form

Neueste Artikel

SQL zu VBA Konverter
26. Oktober 2018
Problemstellung: Nur für 32Bit Office Versionen Gibt es eine Möglichkeit SQL-Code einer Abfrage so zu konvertieren das der Code in VBA genutzt werden kann? Lösung: Bis Access 2010 gibt das Tool...
1.png5.png7.png6.png0.png6.png5.png
Heute61
Gestern206
Diese Woche267
Dieser Monat4688
Total1576065

  • IP: 44.221.43.208
  • Browser: Unknown
  • Version:
  • OS: Unknown

Online

1
Online

19. März 2024

Letzte Kommentare

  • Berechnen von Zeiträumen als Abfragekriterium

    elmard 02.02.2021 21:02
    1000 Dank
    für diese Datenbankanwendung! Eine sehr gute Umsetzung mit den vielen Möglichkeiten des Datums.

    Weiterlesen...

     
  • SQL zu VBA Konverter

    Tommy Admin 03.11.2019 16:33
    RE: SQL zu VBA Konverter
    Hallo Elmard, danke für die Info. :lol:

    Weiterlesen...

     
  • SQL zu VBA Konverter

    elmard 03.11.2019 14:49
    Bei SmartTools neue Version 4.0
    Dieses Tool liegt inzwischen in der Version 4 vor und läuft nun auch von A2013 und A2016 sowie im ...

    Weiterlesen...

     
  • Workshop zur Benutzung des Multi-Column TreeView Control unter MS-Access

    TommyK 27.02.2019 06:52
    Workshop
    Hallo mpegjunkie, danke für Dein Feedback. Schön das Dir Workshop weiter hilft. :D

    Weiterlesen...

     
  • Workshop zur Benutzung des Multi-Column TreeView Control unter MS-Access

    mpegjunkie 26.02.2019 20:10
    Perfekter Workshop
    Hallo Tommy, perfekter Workshop, toll und umfassend erläutert. Jetzt nutze ich diese Controls auch.

    Weiterlesen...