[2007]Utilisation de la classe ClExif dans une msgbox(formulaire)

Bonjour à tous,
J'utilise la classe ClExif d'arkham46 pour lire les métadonnées des fichiers jpg.
Je renseigne mabase en en scrutant un fichier texte qui contient les chemins de toutes les photos. je les affiche une à une dans un cadre de mon formulaire et ensuite apparait un formulaire en mode msgbox qui me propose des valeurs par défaut. Si la métadonnée date existe je la mets dans la valeur par défaut, je valide/ferme mon formulaire et les valeur saisies ou les métadonnées sont mises à jour dans la table (je simplifie un peu).
Mon problème: depuis l'utilisation de ClExif mon processus s'arrète comme si le fichier texte contenant ma liste de fichiers était arrivée au bout et donc je n'affiche pas la photo suivante.
Il y a donc quelque chose qui, soit me ferme ce fichier texte, soit me dit qu'il est à la fin, soit...
Voici le code du formulaire de départ (où sont proposées les photos)

Code:

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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
Private Sub cmdImporterrepertoire_Click()
Dim dbs As Database
Dim rs As Recordset
Dim MyName As String
Dim MyPath As String
Dim MyDestination As String
Dim extension As String
Dim compteur As Integer
compteur = 0
Dim txtReponseImportMsgBox As Integer
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("tblDocument", dbOpenDynaset)
MyPath = DLookup("[RepertoireSource]", "tblParametreImportation", "[ParImpId] = 1")
'MyName = Dir(MyPath & "*.*") ' pour trouver tous les fichiers
Select Case opgFormatDocument
    Case 1
        MyName = Dir(MyPath & "*.pdf")
        Me!AcroPDF6.Visible = True
        Me!imgPhoto.Visible = False
        Me!OleWord.Visible = False
        Me!OleExcel.Visible = False
 
    Case 2
        MyName = Dir(MyPath & "*.jpg")
        Me!imgPhoto.Visible = True
        Me!AcroPDF6.Visible = False
        Me!OleWord.Visible = False
        Me!OleExcel.Visible = False
 
    Case 5
        MyName = Dir(MyPath & "*.*")
        Me!OleWord.Visible = False
        Me!OleExcel.Visible = False
        Me!AcroPDF6.Visible = False
        Me!imgPhoto.Visible = False
 
    Case Else
End Select
If Me.chkTransferFichier Then
    MyDestination = DLookup("[RepertoireDestination]", "tblParametreImportation", "[ParImpId] = 1")
End If
Dim FSys As Object
Dim TRACE As Object
Dim OpenTRACE
Dim LeFichierTrace As String
Dim Chemin As String
Dim reponse As String
Dim derniercree As String
Dim ExisteDansBase As Long
Dim CptExisteDansBase As Integer
CptExisteDansBase = 0
Dim passe As Integer
passe = 0
Dim result As String
LeFichierTrace = "c:\temp\TRACE.txt" ' fichier texte qui contiendra la liste des noms des fichiers
 
'Pour creer le fichier texte si il existe pas
Set FSys = CreateObject("Scripting.FileSystemObject")
If FSys.FileExists(LeFichierTrace) = False Then
Set TRACE = FSys.CreateTextFile(LeFichierTrace)
End If
 
'Ouverture en ecriture du Fichier texte
Set TRACE = FSys.GetFile(LeFichierTrace)
Set OpenTRACE = TRACE.OpenAsTextStream(2, -2)
'8 = ForAppending = Ouvre un fichier et écrit à la fin du fichier.
'2 = ForWriting
'1 = ForReading
Do While MyName <> ""
If Me.chkTransferFichier Then
    ExisteDansBase = Nz(DLookup("[Docnum]", "tblDocument", "[Fichier] = '" & MyDestination & MyName & "' "), 0)
Else
    ExisteDansBase = Nz(DLookup("[Docnum]", "tblDocument", "[Fichier] = '" & MyPath & MyName & "' "), 0)
End If
            Debug.Print "ExisteDansBase  " & ExisteDansBase
If ExisteDansBase > 0 Then
    Me.txtReponseImportMsgBox = 7
    CptExisteDansBase = CptExisteDansBase + 1
        Debug.Print "ignorés  "; CptExisteDansBase
Else
    Select Case opgFormatDocument
        Case 1  'Pdf
            Me!AcroPDF6.src = MyPath & MyName
            DoCmd.OpenForm "frmImportMsgBox", , , , , acDialog, MyPath & MyName
        Case 2  'Photo
            Me.imgPhoto.Picture = MyPath & MyName
            DisplayPhoto
            DoCmd.OpenForm "frmImportMsgBox", , , , , acDialog, MyPath & MyName
        Case 5  'Autres formats
        extension = Right(MyName, 3)
        Debug.Print "ext   "; extension
 
            Select Case extension
                Case "pdf", "doc", "xls", "jpg"
                    Me.txtReponseImportMsgBox = 7
                    Debug.Print "reponse  "; Me.txtReponseImportMsgBox
                Case Else
                    ShellExecute Me.hwnd, vbNullString, MyPath & MyName, "", vbNullString, 1
                    DoCmd.OpenForm "frmImportMsgBox", , , , , acDialog, MyPath & MyName
            End Select
        Case Else
            MsgBox "Format non prévu"
    End Select
  '  result = Nz(ExisteDansBase = DLookup("[Fichier]", "tblDocument", "[Fichier] = '" & MyPath & MyName & "' "), "")
 End If
'Analyse de la réponse du formulaire frmImportMsgBox
    Select Case Me.txtReponseImportMsgBox
        Case 6  'Oui
            '10/07 DoCmd.OpenForm "frmValeurDefaut", acNormal, , "[ParImpId] = 1", acFormEdit, acDialog
            rs.AddNew
            If Me.chkTransferFichier Then
                rs![Fichier] = MyDestination & MyName
            Else
                rs![Fichier] = MyPath & MyName
            End If
            rs![Titre] = DLookup("[TitreDef]", "tblParametreImportation", "[ParImpId] = 1")
            rs![Auteur] = DLookup("[AuteurDef]", "tblParametreImportation", "[ParImpId] = 1")
            rs![Sujet] = DLookup("[SujetDef]", "tblParametreImportation", "[ParImpId] = 1")
            rs![Motscles] = DLookup("[MotsClesDef]", "tblParametreImportation", "[ParImpId] = 1")
            rs![Creationdate] = DLookup("[CreationDateDef]", "tblParametreImportation", "[ParImpId] = 1")
            rs![Categorie] = DLookup("[CategorieDef]", "tblParametreImportation", "[ParImpId] = 1")
            rs![Gisement] = DLookup("[GisementDef]", "tblParametreImportation", "[ParImpId] = 1")
            rs![Importdate] = Time()
            rs.Update
            rs.MoveLast
            derniercree = rs![Docnum]
            'Debug.Print "avant copie                " & MyName
            If Me.chkTransferFichier Then
            ' Copie du fichier de l Emplacement Initial vers l Emplacement Final
                FileCopy MyPath & MyName, MyDestination & MyName
                'Debug.Print "après copie                " & MyName
            End If
            DoCmd.OpenForm "frmDocumentImport", acNormal, , "Docnum =" & derniercree, acFormEdit, acDialog
            'Debug.Print "après ouverture formulaire " & MyName
 
             '__ Effacement du fichier sur l'emplacement initial LE FICHIER DOIT ETRE FERME
            If Me.chkTransferFichier Then
                Kill MyPath & MyName
            End If
            OpenTRACE.Write MyPath & MyName & (Chr(13) + Chr(10))
            'Debug.Print "après openTRACE            " & MyName
            'Fichier suivant
            MyName = Dir
            'Debug.Print "après MyName = Dir         " & MyName
            compteur = compteur + 1
 
        Case 7  'Non
        passe = passe + 1
        Debug.Print "passe  " & passe
            OpenTRACE.Write MyPath & MyName & (Chr(13) + Chr(10))
            MyName = Dir
 
        Case 2  'Annuler
            FermerApplication
            Exit Do
 
    End Select
FermerApplication
Loop
Select Case compteur
    Case 0
    'soust =
        MsgBox "Aucun document n'a été traité  " & CptExisteDansBase & " documents ignorés car le fichier est déjà présents dans la base  " & passe - CptExisteDansBase & " passés par vous même", 64, "Fin de la procédure d'importation"
    Case 1
        MsgBox "1 document a été traité  " & CptExisteDansBase & " documents ignorés car le fichier est déjà présents dans la base  " & passe - CptExisteDansBase & " passés par vous même", 64, "Fin de la procédure d'importation"
    Case Else
        MsgBox compteur & " documents ont été traités  " & CptExisteDansBase & " documents ignorés car le fichier est déjà présents dans la base  " & passe - CptExisteDansBase & " passés par vous même", 64, "Fin de la procédure d'importation"
End Select
    '"Impossible de masquer le contrôle actif" pour word, excel
        'Me.OleWord.Action = acOLEClose
        'Me!OleWord.Visible = False
        'Me!OleExcel.Visible = False
    'solution: fermer le formulaire
    Me!AcroPDF6.Visible = False
        Me!imgPhoto.Visible = False
    DoCmd.Close
 
End Sub

et le code du formulaire des valeurs par défaut où sont éventuellement prises en compte les métadonnées

Code:

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
Option Compare Database
Option Explicit
'***Exif***
' Déclaration de la classe pour lecture données Exif
Dim clex As New ClExif
'***Exif***
Private Sub Form_Close()
' Libération de la classe à la fermeture du formulaire
If Not clex Is Nothing Then Set clex = Nothing
End Sub
Private Sub Form_Load()
'***exif***
Dim Fichier As String
Dim SQLDateExif As String
Fichier = txtMessage
' Variable pour donnée brute
Dim lData As Variant
' Gestion d'erreurs rapide
On Error Resume Next
' Ouverture du nouveau fichier
clex.OpenFile Fichier
' Description
EImageDescription = clex.GetExifData(TagImageDescription)
' Auteur
EArtist = clex.GetExifData(TagArtist)
' Date du cliché
'EDateTimeOriginal.Value = Format(clex.GetExifData(TagDateTimeOriginal), "dd/mm/yyyy")
If EDateTimeOriginal.Value Is Not Null Then
    SQLDateExif = "UPDATE tblParametreImportation SET CreationDateDef = #" & Format(clex.GetExifData(TagDateTimeOriginal), "mm/dd/yyyy") & "# WHERE ParImpId = 1 ;"
DoCmd.RunSQL SQLDateExif
End If
End Sub
Private Sub cmdEffacerValDef_Click()
Dim SQLEffValDef As String
SQLEffValDef = "UPDATE tblParametreImportation SET TitreDef = '' WHERE ParImpId = 1 ;"
DoCmd.RunSQL SQLEffValDef
SQLEffValDef = "UPDATE tblParametreImportation SET AuteurDef = '' WHERE ParImpId = 1 ;"
DoCmd.RunSQL SQLEffValDef
'DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Requery
End Sub
'Private Sub cmdEffacerValDef_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Requery
'End Sub
' Positionner le formulaire dès son ouverture
'
Private Sub Form_Open(Cancel As Integer)
With Form
'W4700
    .Move Left:=50, Top:=1000, Width:=7000, Height:=6500
End With
End Sub
Private Sub cmdCreer_Click()
Forms!frmImportation!txtReponseImportMsgBox.Value = 6
DoCmd.Close
End Sub
Private Sub cmdPasser_Click()
Forms!frmImportation!txtReponseImportMsgBox.Value = 7
DoCmd.Close
End Sub
Private Sub cmdAnnuler_Click()
Forms!frmImportation!txtReponseImportMsgBox.Value = 2
DoCmd.Close
End Sub

Merci de votre attention

Bjr,

Quel est le résultat du MyName = Dir??
Sinon FermerApplication avant le Loop c'est normal?

Bonjour arkham,

Un debug print de MyName me donne le nom du premier (et du seul) fichier traité.

FermerApplication est desactivé.

Ok je crois que j'ai compris (enfin j'espère)

Dans l'initialization de la classe, je charge la librairie gdiplus.dll qui se trouve dans le répertoire courant.
Pour trouver ce répertoire courant j'utilise une instruction Dir qui doit annuler la tienne.
Donc essaye de changer dans la classe ClExif la fonction ApplicationPath.

Actuellement ça doit être :
Code:

1 2 3 4 Private Function ApplicationPath() As String ApplicationPath = Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir(CurrentDb.Name))) End Function
Il faut se débarrasser du Dir (le code suivant est pour access >= 2000):
Code:

1 2 3 4 Private Function ApplicationPath() As String ApplicationPath = CurrentProject.Path & "\" End Function

La modif me donne une erreur "incompatibilité de type" sur

Code:

Set rs = dbs.OpenRecordset("tblDocument", dbOpenDynaset)

Citation:

Envoyé par tAKAmAkA

La modif me donne une erreur "incompatibilité de type" sur

Code:

Set rs = dbs.OpenRecordset("tblDocument", dbOpenDynaset)

là je ne vois pas le rapport avec la modif précédente..

tu devrais préciser que tu travailles avec des objets DAO (à priori la référence ADO est également cochée et prioritaire, voir dans outils --> références)
Code:

1 2 3 Dim dbs As DAO.Database Dim rs As DAO.Recordset

Si je déclare
Code:

1 2 Dim dbs As DAO.Database Dim rs As DAO.Recordset
j'ai déclaration existante dans la portée en cours alors que je n'ai pas d'autre déclaration de ce type dans le code de mon formulaire.

Dans les références je n'ai rien de coché concernant ADO.

Citation:
Envoyé par tAKAmAkA
Si je déclare
Code:

1 2 Dim dbs As DAO.Database Dim rs As DAO.Recordset
j'ai déclaration existante dans la portée en cours alors que je n'ai pas d'autre déclaration de ce type dans le code de mon formulaire.

Dans les références je n'ai rien de coché concernant ADO.
Là je sèche un peu...
Je ne comprend pas trop comment ces modifs mènent à ces messages.

Si ça fait n'importe quoi, dans ces cas là j'exporte le module ou formulaire, je le supprime et je le réimporte ... (au grands maux ...)

A moins que quelqu'un d'autre y comprenne quelque chose, c'est vendredi alors c'est dur...

Merci tout de même pour ton aide.
Cordialement.

J'ai caffouillé quelque part.
Les solutions sont bien celles données par arkham:

Code:

ApplicationPath = CurrentProject.Path & "\"

et précision DAO sur la déclaration du recordset
Code:

1 2 Dim dbs As DAO.Database Dim rs As DAO.Recordset
.
Merci.
Cordialement.