Ecrire une métadonnée XMP au départ d'une autre.Résolu

Question

Bonjour,
Je ne suis pas développeur et ne connais qu'un tout petit peu VBA. Vraiment débutant ++. Mais je comprends vite.
Je me débrouille pour ouvrir un fichier dans un répertoire, du style:
Set fso = CreateObject("Scripting.FileSystemObject")
With Application.FileSearch
    .LookIn = "C:\Mes Documents")
    .Filename = "*.*"
    .Execute
NbreFichiers = .FoundFiles.Count
For i = 1 To NbreFichiers
        Set f = fso.GetFile(.FoundFiles(i))
Next i

Voulant manipuler mes photos par lots pour les renommer, j'ai trouvé sur http://members.cox.net/foxbat121/exifview.html#_Link, une dll (ExifView.dll) qui me permet ce code (accès en lecture aux propriétés Exif de image1.jpg) :

Dim col As ExifTags
Dim tg As ExifTag
Dim ExifObjet As ExifPage
Dim Message As String



' create ExifPage object
Set ExifObjet = New ExifPage



' extract exif info in the file named and it will return ExifTags collection object
Set col = ExifObjet.ExtractExifInfo("C:\Mes Documents\image1.jpg")



' get all the ExifTag objects for information
For Each tg In col
      Message = Message + tg.Name + " : " + vbTab + tg.Value + vbCrLf



Next
MsgBox Message


J'aimerais maintenant accéder aux propriétés XMP de la photo, en lecture et en écriture.
(en fait, c'est pour insérer automatiquement [j'ai 7000 photos à traiter] la date de prise de vue et le nom du fichier image dans le champs XMP 'Description' correspondant aussi au champs IPTC 'Légende'... celui que Picassa permet d'afficher dans son diaporama!)
Mais ma dll ExifView.dll ne traite pas ces métadonnées XMP...

Merci de me renseigner :
1. quelle XXX.dll charger dans C:\WINDOWS\system32 (et faire tourner "regsvr32.exe XXX.dll")
2. m'écrire un bout de code qui écrive dans la 'Description' de l'image "C:\Mes Documents\image1.jpg" la date de prise de vue (format YYYY-MM-hhm°mm°ss) suivi du nom du fichier.
Merci ++
JeanFil777

hugoclavet · Accepted Answer

Le très puissant Exiftool est gratuit. Programme en ligne de commande seulement. Petit example pour utiliser en écriture a partir de vb. Je n'ai pas le temps de raffiner ça mais voila quand même: Private Sub cmdÉcrit_Click() Dim astrMotsClés() As String Dim dDate As Date Dim tz As New cTimeZone Dim inta As Integer dDate = DateAdd("h", -Val(tz.Offset), Now) Set tz = Nothing ReDim astrMotsClés(1 To 2) astrMotsClés(1) = "Mot clé 1" astrMotsClés(2) = "Mot clé 2" ExifInfo "c:", "C: est.jpg" ExifWrite "c:", "C: est.jpg", "Ici le titre", "Ici la description", "Ici l'auteur", 5, astrMotsClés, dDate, "Commentaire", "Copyright" End Sub Private Function ExifWrite(ExifToolPath As String, Fichier As String, Titre As String, _ Description As String, Auteur As String, _ Notation As Integer, MotsClés() As String, _ dDatePriseDeVue As Date, Commentaires As String, _ Copyright As String) As Double Dim strCommandLine As String Dim inta As Integer strCommandLine = ExifToolPath & "exiftool " If Titre <> "" Then strCommandLine = strCommandLine & "-title=""" & Titre & """ " strCommandLine = strCommandLine & "-XPTitle=""" & Titre & """ " End If If Commentaires <> "" Then strCommandLine = strCommandLine & "-UserComment=""" & Commentaires & """ " strCommandLine = strCommandLine & "-XPComment=""" & Commentaires & """ " End If If Description <> "" Then strCommandLine = strCommandLine & "-title=""" & Description & """ " End If If Auteur <> "" Then strCommandLine = strCommandLine & "-creator=""" & Auteur & """ " strCommandLine = strCommandLine & "-XPAuthor=""" & Auteur & """ " End If If Copyright <> "" Then strCommandLine = strCommandLine & "-xmp:rights=""" & Copyright & """ " End If strCommandLine = strCommandLine & "-DateTimeOriginal=""" & dDatePriseDeVue & """ " Dim intNotationPourcent As Integer Select Case Notation Case Is = 0 intNotationPourcent = 0 Case Is = 1 intNotationPourcent = 1 Case Is = 2 intNotationPourcent = 25 Case Is = 3 intNotationPourcent = 50 Case Is = 4 intNotationPourcent = 75 Case Is = 5 intNotationPourcent = 99 Case Else intNotationPourcent = 0 End Select If Notation < 6 Then strCommandLine = strCommandLine & "-Rating=""" & Notation & """ " strCommandLine = strCommandLine & "-RatingPercent=""" & intNotationPourcent & """ " Else strCommandLine = strCommandLine & "-Rating=5 " strCommandLine = strCommandLine & "-RatingPercent=""" & 99 & """ " End If For inta = LBound(MotsClés) To UBound(MotsClés) strCommandLine = strCommandLine & "-keywords=""" & MotsClés(inta) & """ " strCommandLine = strCommandLine & "-LastKeywordXMP=""" & MotsClés(inta) & """ " strCommandLine = strCommandLine & "-Subject=""" & MotsClés(inta) & """ " Next inta strCommandLine = strCommandLine & "-XPKeywords=""" & Join(MotsClés, ";") & """ " strCommandLine = strCommandLine & "-k -fast " 'k pour que la fenetre ne se ferme pas, fast surement inutile en ecriture strCommandLine = strCommandLine & """" & Fichier & """" ExifWrite = Shell(strCommandLine, vbNormalFocus) 'Pour que la fenetre ne se ferme pas End Function Private Sub ExifInfo(ExifToolPath As String, Fichier As String) Dim strCommandLine As String Dim inta As Integer strCommandLine = ExifToolPath & "exiftool " strCommandLine = strCommandLine & "ScanForXMP " strCommandLine = strCommandLine & """" & Fichier & """ -k" Shell strCommandLine, vbNormalFocus End Sub Hugo

hugoclavet · Answer

Essaye chilkat xmp activex...

Hugo

Jeanfil777 · Answer

Merci du tuyau Hugo ... mais sur http://www.softpedia.com/get/Programming/Components-Libraries/Chilkat-XMP-ActiveX-Component.shtml,
ça revient quand-même à 149$...
Un tuyau pour un équivalent gratuit ?

JeanFil777

Jeanfil777 · Answer

Merci ++
Je vais essayer ça d'ici une ou deux semaines (peu de temps en ce moment).
Me donneriez-vous votre email pour vous joindre au cas où... ?
Si oui, me joindre sur jean-philippe.renders(arobase)wanadoo.fr
Cordialement.

JeanFil777

Ecrire une métadonnée XMP au départ d'une autre.

4 réponses

Votre réponse

Discussions similaires