GetExifData & GPSExifReader: Adaptation de codes

**zkunk** · 01/06/2017, 17h38

Bonjour à tous,
Je cherche à récupérer les informations EXIF de fichiers JPEG (des photos).
Ces informations concernent :
1) l'auteur, la date, l'appareil photo utilisé, etc..
2) mais aussi un autre type de données telles que les données GPS qui pourraient y figurer.
J'ai trouvé un premier tuto: http://arkham46.developpez.com/artic...s/clexif/tuto/ qui me permet de récupérer les informations (1) auteur, date, etc. mais le code ne remonte aucune info GPS.
Je suis donc tombé sur un autre tuto, de Wayne Phillips http://www.everythingaccess.com/tuto...rom-JPEG-files qui lui me remonte uniquement les infos (2) GPS.

Ces codes fonctionnent tout d'eux avec un formulaire qui via un bouton permet de charger une image : un emplacement de fichier. Et ensuite les codes font l’extraction depuis cet emplacement, des EXIF vers des zones de texte.

Mon problème est que j'ai des milliers de photo à traiter et je dois récupérer TOUTES ces infos. C'est pourquoi j'aimerai adapter chacun de ces deux codes, afin qu'ils travaillent sur toute les lignes d'une table contenant le chemin des images, car actuellement ils ne travaillent que sur un seul fichier photo à la fois..

J'ai donc créé un fichier access neuf, sur lequel j'ai repris les deux codes existants ainsi que leurs formulaire. J'ai créé un table T_image avec les emplacement des images mais aussi les champs prêts à recevoir les EXIF.
Je viens chercher de l'aide pour m'aider à réaliser cet adaptation. D'après mes faible connaissance je pense qu'il faudrait créer une requête qui appellerait ces fonctions?
Cependant je ne sais pas du tout par quel bout m'y prendre: je ne sais pas si il faut que je commence par synchroniser les codes sur un seul formulaire (car la chacun fonctionne sur son formulaire)... et dans un second temps créer une requete pour travailler sur toute la table? ou alors, faut il faire deux requetes distinctes ?

Un extrait du premier code qui permet d'extraire les infos (1) auteur, date, etc.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Private Sub TFichier_AfterUpdate()
' Variable pour donnée brute
    Dim lData As Variant
' Gestion d'erreurs rapide
    On Error Resume Next
' Ouverture du nouveau fichier
    clex.OpenFile TFichier
    lData = clex.GetExifData(TagMakerNote)
' Taille de l'image
    ETaille.Value = clex.GetExifData(TagImageWidth) & " x " & clex.GetExifData(TagImageHeight)
' Vitesse ISO
    EISOSpeedRatings.Value = Format(clex.GetExifData(TagISOSpeedRatings), "\I\S\O 000")
' Modèle appareil
    EEquipModel.Value = clex.GetExifData(TagEquipModel)
' Fabricant
    EEquipMake.Value = clex.GetExifData(TagEquipMake)
' Version EXIF
    EExifVersion = clex.GetExifData(TagExifVersion)
' Description
    EImageDescription = clex.GetExifData(TagImageDescription)
' Auteur
    EArtist = clex.GetExifData(TagArtist)
' Date du cliché
    EDateTimeOriginal.Value = Format(clex.GetExifData(TagDateTimeOriginal), "d mmmm yyyy" & vbCrLf & "hh:nn:ss")
' Miniature
    Me.Image0.Picture = ""
    Me.Image0.PictureData = clex.GetExifData(TagThumbnailData)
' Temps exposition
    ' On stock  d'abord le résultat dans lData
    lData = clex.GetExifData(TagExposureTime)
    ' On obtient un tableau de 2 valeurs
    If Not IsNull(lData) Then
        If lData(1) > lData(0) Then
            ' Temps inférieur à  1 secondes
            EExposureTime.Value = "1/" & Int(lData(1) / lData(0)) & " secondes"
        Else
            ' Temps supérieur ou égal à 1 secondes
            EExposureTime.Value = Int(lData(0) / lData(1)) & " secondes"
        End If
    Else
        EExposureTime.Value = Null
    End If
' Point -F
    lData = clex.GetExifData(TagFNumber)
    If Not IsNull(lData) Then
        EFNumber.Value = Format(lData(0) / lData(1), "F0.0")
    Else
        EFNumber.Value = Null
    End If
' Flash
    lData = clex.GetExifData(TagFlash)
    If Not IsNull(lData) Then
    EFlash.Value = IIf(Mid(lData, 8, 1) = "1", "Flash déclenché", "Flash non déclenché")
    EFlash.Value = EFlash.Value & vbCrLf & Switch(Mid(lData, 4, 2) = "00", "Mode inconnu", _
                                                  Mid(lData, 4, 2) = "01", "Flash forcé", _
                                                  Mid(lData, 4, 2) = "10", "Flash désactivé", _
                                                  Mid(lData, 4, 2) = "11", "Flash auto")
    EFlash.Value = EFlash.Value & vbCrLf & Switch(Mid(lData, 2, 1) = "0", "Anti-Yeux rouges désactivé", _
                                                  Mid(lData, 2, 1) = "1", "Anti-Yeux rouges activé")
    Else
        EFlash.Value = Null
    End If
End Sub

Et maintenant le code de celui qui affiche les données GPS

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
Private Sub btnBrowseAndOpen_Click()
 
On Error GoTo ExifError
 
    Dim strDump As String
 
    txtOutput.Value = ""    ' Clear the output before starting.
 
    With GPSExifReader.BrowseAndOpenFile()
 
        strDump = strDump & "FilePath:                  " & .FilePath & vbCrLf
        strDump = strDump & "DateTimeOriginal:          " & .DateTimeOriginal & vbCrLf
        strDump = strDump & "GPSVersionID:              " & .GPSVersionID & vbCrLf
        strDump = strDump & "GPSLatitudeDecimal:        " & .GPSLatitudeDecimal & vbCrLf
        strDump = strDump & "GPSLongitudeDecimal:       " & .GPSLongitudeDecimal & vbCrLf
        strDump = strDump & "GPSAltitudeDecimal:        " & .GPSAltitudeDecimal & vbCrLf
 
 
        txtOutput.Value = strDump
 
    End With
 
    Exit Sub
 
ExifError:
    MsgBox "An error has occurred in btnBrowseAndOpen_Click():" & vbCrLf & vbCrLf & Err.Description
 
End Sub

Les infos que je dois donc récupérer et rajouter dans la table via la requete sont :
Pour le premier code: EExposureTime ;EFNumber ; etc.
Pour le deuxième code: .GPSAltitudeDecimal ; .GPSLongitudeDecimal ; .GPSVersionID

En vous remerciant par avance pour votre aide, infos, piste
J'ai mis une version en 2002 et une version 2007-16 du fichier dans le zip

zunk

Invité · 01/06/2017, 22h29

Bonjour,

ci-joint une solution via dao pour mettre à jour toutes les lignes de la table t_image.
Coller tout le code suivant dans un nouveau module VBA standard :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
 
Public Function MaJExifGpsTableImage() As Boolean
On Error GoTo MyErr
Dim oDb As DAO.Database, oRs As DAO.Recordset
Dim oExif As ClExif, oGps As GPSExifReader
Dim PathImage As String, ErrMsg As String, TmpMsg As String, i As Long
 
Set oExif = New ClExif
Set oGps = New GPSExifReader
 
Set oDb = CurrentDb
Set oRs = oDb.OpenRecordset("t_image", dbOpenTable)
 
With oRs
While Not .EOF
    If Not (IsNull(!nomfichier) Or IsNull(!dossier)) Then
        PathImage = !dossier & IIf(Right$(Trim$(!dossier), 1) <> "\", "\", "") & !nomfichier
        .Edit
            TmpMsg = setExifTableImage(oRs, oExif, PathImage)
            TmpMsg = TmpMsg & setGPSTableImage(oRs, oGps, PathImage)
        .Update
        If Len(TmpMsg) = 0 Then i = i + 1 Else: ErrMsg = ErrMsg & TmpMsg
    Else
        ErrMsg = ErrMsg & "NomFichier et/ou Dossier non renseigné pour l'image :'" & !nomimage & "'"
    End If
    .MoveNext
Wend
.Close
End With
 
fin:
Set oRs = Nothing
Set oDb = Nothing
Set oExif = Nothing
Set oGps = Nothing
 
TmpMsg = i & " lignes de la table ont été mises à jour avec succès"
 
If Len(ErrMsg) > 0 Then
    MsgBox "Des erreurs sont survenues, voir détails dans la fenêtre exécution", vbInformation, "MaJExifGpsTableImage()"
    Debug.Print TmpMsg & vbCrLf & ErrMsg
Else
    MsgBox "Mise à jour terminée sans erreur" & vbCrLf & TmpMsg, vbInformation, "MaJExifGpsTableImage()"
End If
Exit Function
 
MyErr:
    MsgBox "Erreur grave n°" & Err.Number & vbCrLf & Err.Description, vbCritical, "MaJExifGpsTableImage()"
    GoTo fin
End Function
 
Private Function setExifTableImage(ByRef Rs As DAO.Recordset, ByRef clEx As ClExif, ByVal TFichier As String) As String
' Variable pour donnée brute
    Dim lData As Variant, f As String
' Gestion d'erreurs rapide
    On Error Resume Next
 
' Ouverture du nouveau fichier
    If Not clEx.OpenFile(TFichier) Then
        setExifTableImage = "Erreur ouverture image : " & TFichier & " par oExif" & vbCrLf
    Else
            lData = clEx.GetExifData(TagMakerNote)
 
        With Rs
        ' Taille de l'image
            !taille = clEx.GetExifData(TagImageWidth) & " x " & clEx.GetExifData(TagImageHeight)
        ' Vitesse ISO
            ![Vitesse ISO] = Format(clEx.GetExifData(TagISOSpeedRatings), "\I\S\O 000")
        ' Modèle appareil
            ![Modèle appareil] = clEx.GetExifData(TagEquipModel)
        ' Fabricant
            !fabricant = clEx.GetExifData(TagEquipMake)
        ' Version EXIF
            ![Version EXIF] = clEx.GetExifData(TagExifVersion)
        ' Description
            'EImageDescription = clEx.GetExifData(TagImageDescription)
        ' Auteur
            !auteur = clEx.GetExifData(TagArtist)
        ' Date du cliché
            ![Date cliché] = Format(clEx.GetExifData(TagDateTimeOriginal), "d mmmm yyyy" & vbCrLf & "hh:nn:ss")
        ' Miniature
            'Me.Image0.Picture = ""
            'Me.Image0.PictureData = clEx.GetExifData(TagThumbnailData)
        ' Temps exposition
            ' On stock  d'abord le résultat dans lData
            lData = clEx.GetExifData(TagExposureTime)
            ' On obtient un tableau de 2 valeurs
            If Not IsNull(lData) Then
                If lData(1) > lData(0) Then
                    ' Temps inférieur à  1 secondes
                    ![Temps exposition] = "1/" & Int(lData(1) / lData(0)) & " secondes"
                Else
                    ' Temps supérieur ou égal à 1 secondes
                    ![Temps exposition] = Int(lData(0) / lData(1)) & " secondes"
                End If
            Else
                ![Temps exposition] = vbNullString
            End If
        ' Point -F
            lData = clEx.GetExifData(TagFNumber)
            If Not IsNull(lData) Then
                ![Point-F] = Format(lData(0) / lData(1), "F0.0")
            Else
                ![Point-F] = vbNullString
            End If
        ' Flash
            lData = clEx.GetExifData(TagFlash)
            If Not IsNull(lData) Then
            f = IIf(Mid(lData, 8, 1) = "1", "Flash déclenché", "Flash non déclenché")
            f = f & vbCrLf & Switch(Mid(lData, 4, 2) = "00", "Mode inconnu", _
                                                          Mid(lData, 4, 2) = "01", "Flash forcé", _
                                                          Mid(lData, 4, 2) = "10", "Flash désactivé", _
                                                          Mid(lData, 4, 2) = "11", "Flash auto")
            f = f & vbCrLf & Switch(Mid(lData, 2, 1) = "0", "Anti-Yeux rouges désactivé", _
                                                          Mid(lData, 2, 1) = "1", "Anti-Yeux rouges activé")
 
            End If
            !Flash = f
 
        End With
    End If
End Function
 
Private Function setGPSTableImage(ByRef Rs As DAO.Recordset, ByRef oGps As GPSExifReader, ByVal TFichier As String) As String
    On Error GoTo MyErr
 
    With oGps.OpenFile(TFichier)
        Rs!GPSVersionID = .GPSVersionID
        Rs!GPSLatitudeDecimal = .GPSLatitudeDecimal
        Rs!GPSLongitudeDecimal = .GPSLongitudeDecimal
        Rs!GPSAltitudeDecimal = .GPSAltitudeDecimal
    End With
fin:
Exit Function
MyErr:
    setGPSTableImage = "Erreur lecture image : " & TFichier & " par GPSExifReader" & vbCrLf
    GoTo fin
End Function

Pour lancer la fonction de mise à jour des données de la table, mettre le curseur dans le code de la fonction "MaJExifGpsTableImage" puis appuyer sur la touche F5 pour l'exécuter

**micniv** · 01/06/2017, 22h51

Bonsoir,
J'ai fait une composition rapides des 2 codes dans un nouveau form "Frmtest_MN"
en partant du formulaire de Wayne Philips puis en déclarant la classe d'Arkham à l'ouverture du form.

Ci-joint le résultat :

CDLT

**zkunk** · 02/06/2017, 16h51

Bonjour, galoir, micniv,

Tout d'abord merci à vous deux pour vos solutions qui fonctionnent et qui sont complémentaires:
* celle de galoir, qui extrait les Exif pour l'ensemble des images d'une table et qui enregistre ces infos dans la table
* celle micniv, qui extrait l'ensemble des infos (gps & data classic) Exif d'une photo.

Je pense que ça pourra en aider plus d'un, pour ma part je part sur la version de galoir car ça répond à ma problématique de masse.

Donc on a réussi à LIRE les EXIF d'un JPEG. Serait-il possible d'ECRIRE dans les EXIF d'un JPEG en VBA ?
L'idée serait de faire exactement l'inverse:
Partir de la base de donnée t_image, avec les adresse des JPEG, ainsi que les champs de chaque EXIF à exporter. Lancer le code pour écrire sur les EXIF des JPEG.

En vous remerciant pour le temps consacré à cette thématique,

zunk

Invité · 02/06/2017, 18h29

Bonjour,

c'est tout à fait faisable, Arkham46 le magnifique

a tout prévu : Fonction SetExifData() et SaveFile()

Le seul truc qui peut poser quelques problèmes est la conversion du format et du type des données à l'écriture (date, numérique, etc...)

**zkunk** · 03/06/2017, 14h11

le seul truc si je ne m'abuse c'est que les TAG modifiables sont limités?
Par exemple, je peux changer l'auteur de la photo, mais pas ses coordonnées GPS ou son altitude GPS?

Merci =)

Invité · 03/06/2017, 20h28

En effet, les tags gps ne sont pas modifiables, les classes vba de Wayne Phillips n'offrent pas cette possibilité.

Je vois, sans trop avoir cherché, deux solutions possibles (relativement simples ?) dans ce cas :
1) possibilité de mettre à jour les tags via la librairie WIA
http://silkyroad.developpez.com/VBA/...geAcquisition/
et https://www.developpez.net/forums/d1...s-macro-excel/

2) Utiliser un executable en ligne de commande qui met à jour les tags exif

GetExifData & GPSExifReader: Adaptation de codes [AC-2002]

VBA Access

Discussions similaires

Partager

Partager