TKSoft-Online

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.

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

Arbeiten mit EXIF-Tags und der GDI+ Library

Downloads in dieser Kategorie

MS-Access Datei & System

Seite: 1

• Auslesen und ändern von Dateiattributen
Auslesen und Ändern von Dateiattributen unter VBA durch die
GetAttr- und SetAttr-Funktion und auslesen von Dateidatumsangaben
mittels der Scripting von MS.
für A97-A03 , A07 nicht getestet

Die Zip-Datei enthält ein Version für A97 und eine ab A00
• Verwendung DSO-Framer Control A00-A03

Bsp-DB für die Verwendung DSO-Framer Control
für A00-03

Die Zip-Datei enthält ein Version ab A00

• Verwendung DSO-Framer Control A07

Bsp-DB für die Verwendung DSO-Framer Control
für A07

Die Zip-Datei enthält ein Version ab A07

• Setup tkFileFunc-DLL
Bsp-DB zur Benutzung der tk_FileFunc.dll
Setup enthält folgende Dateien:

tk_FileList.mdb
tkFileFunc.dll

Für MS-Access ab A00-A07
getestet unter WinXP, Win Vista 32Bit und Win7 64Bit
• Auslesen und ändern von Datei-/Verzeichnisattributen
Auslesen und ändern von Datei-/Verzeichnisattributen mittels
FileSystemObject der MS-Scripting Runtime
für A97-A03 , A07 nicht getestet

Die Zip-Datei enthält ein Version für A97 und eine ab A00
• Ermitteln und Beenden von externen Programmen

Bsp-DB zum Ermitteln und Beenden von externen Programmen

für A02-A07, unter Vista und Windows7 nicht getestet.


Die Zip-Datei enthält ein Version ab A02
• Arbeiten mit INI-Dateien

Arbeiten mit INI-Dateien
für A00-A07

Die Zip-Datei enthält eine Version ab A00

• Temporäre Installation von TrueTypeFonts

Temporäre Installation von TrueTypeFonts
für A97-A03 , A07 nicht getestet

Die Zip-Datei enthält ein Version für A97 und eine ab A00

• Auslesen von Infos aller Laufwerke im System
Auslesen von Laufwerks-Informationen mittels der Scripting Runtime von MS.
für A97-A03 , A07 nicht getestet

Die Zip-Datei enthält ein Version für A97 und eine ab A00
• Arbeiten mit der Registry

Arbeiten mit der Registry
für A00-A07

Die Zip-Datei enthält eine Version ab A00

Seite: 2

• Arbeiten mit der ShellExecute-Methode

Arbeiten mit der ShellExecute-Methode
für A00-A07

Die Zip-Datei enthält eine Version ab A00-A03 und eine für A07

• Arbeiten mit EXIF-Tags und der GDI+ Library

Arbeiten mit EXIF-Tags und der GDI+ Library

 

Arbeiten mit EXIF-Tags und der GDI+ Library
ab A2000

Die ZIP-Datei enthält eine Version ab A2000

Powered by Tux Merlín Extensions