CODEWITHSUNDEEP
vba
Runarsson
Runarsson

Reputation: 41

Restore metadata in JPG files using VBA

Have now found a program for batch editing which will help me get back in control over my mountain of picture files. Its flipside is that parts of the metadata disappear in the editing. I'm not crying over lost advanced camera settings, but a couple of things I want to preserve are photo date and camera model.

To retrieve selected information was easily done with the method:

Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.Namespace(strFolder)
Set objFolderItem = objFolder.ParseName(strFile)
... followed by...
Cells(2,iColumn).Value = objFolder.getdetailsof(objFolderItem, 12) '(12 = photo taken)*<br>
Cells(3,iColumn).Value = objFolder.getdetailsof(objFolderItem, 30) '(30 = camera model)

(... etc with selected details)

In a loop through a folder the result will be a worksheet with the file names and their metadata in a table... and that's where I am now. I'm searching and I'm searching and the only thing I seem to find are different ways to retrieve the information, but what I want to know is how to put it back into a file.

Thanks in advance.
/Nick

Upvotes: 4

Views: 584

Answers (2)

Haluk
Haluk

Reputation: 1586

You can use the WIA object to read and write meta data in image files.

For example, the following code writes GPS data to a JPG file;

Sub Write_Lon_Lat_Alt_ExifData()
'   Haluk - 03/04/2024
'   Reference : Microsoft Windows Image Acquistion Library V2.0
    
    Dim Longitude As Double, Latitude As Double, Altitude As Long, Img As WIA.ImageFile, IP As WIA.ImageProcess, V As WIA.Vector
    Dim r1 As New Rational, r2 As New Rational, r3 As New Rational, rAlt As New Rational
    Dim myFile As Variant, NewFile As String
    Dim Deg As Integer, Min As Integer, Sec As Double
    
'   GPS Data to be written to the image file
    Longitude = 24.858
    Latitude = 36.761
    Altitude = 1071
    
    Set Img = New WIA.ImageFile
    Set IP = New WIA.ImageProcess
    Set V = New WIA.Vector
    
    myFile = Application.GetOpenFilename("Image Files (*.jpg), *.jpg")
    If myFile = False Then Exit Sub
    
    NewFile = "New_" & Dir(myFile)
    NewFile = Replace(myFile, Dir(myFile), NewFile)
    
    If Dir(NewFile) <> "" Then Kill NewFile
    
    Img.LoadFile myFile
    
    IP.Filters.Add (IP.FilterInfos("Exif").FilterID)
    
    
'   Begin writing Longitude to Image file
'   ------------------------------------
    IP.Filters(1).Properties("ID") = 4
    IP.Filters(1).Properties("Type") = VectorOfUnsignedRationalsImagePropertyType '= 1106
    
    Call Convert_LatLon(Longitude, Deg, Min, Sec)
    
'   Set longitude as vector of unsigned rationals (r1= Degrees, r2= Minutes, r3= Seconds)
    r1.Numerator = Deg
    r1.Denominator = 1
    
    r2.Numerator = Min
    r2.Denominator = 1
    
'   Displaying seconds as Integer
'    r3.Numerator = Sec
'    r3.Denominator = 1
 
'   Displaying seconds as Double
    r3.Numerator = Sec * 100
    r3.Denominator = 100
    
    V.Add r1, 0
    V.Add r2, 0
    V.Add r3, 0
    
    IP.Filters(1).Properties("Value") = V
    
    Set Img = IP.Apply(Img)
'   End of writing Longitude to Image file
'   ----------------------------------
'
'
'   Begin writing Latitude to Image file
'   ------------------------------------
    IP.Filters(1).Properties("ID") = 2
    IP.Filters(1).Properties("Type") = VectorOfUnsignedRationalsImagePropertyType '= 1106
    
    Call Convert_LatLon(Latitude, Deg, Min, Sec)

'   Set latitude as vector of unsigned rationals (r1= Degrees, r2= Minutes, r3= Seconds)
    r1.Numerator = Deg
    r1.Denominator = 1
    
    r2.Numerator = Min
    r2.Denominator = 1
    
'   Displaying seconds as Integer
'    r3.Numerator = Sec
'    r3.Denominator = 1
 
'   Displaying seconds as Double
    r3.Numerator = Sec * 100
    r3.Denominator = 100
    
'   Vector object must be "cleared" or set as "New Wia.Vector" before using again, otherwise old rational values (r1, r2, r3) are retained
    V.Clear
    
    V.Add r1, 0
    V.Add r2, 0
    V.Add r3, 0
    
    IP.Filters(1).Properties("Value") = V
    Set Img = IP.Apply(Img)
'   End of writing Latitude to Image file
'   ----------------------------------
'
'
'   Begin writing Altitude to Image file
'   ------------------------------------
    IP.Filters(1).Properties("ID") = 6
    IP.Filters(1).Properties("Type") = RationalImagePropertyType ' = 1006

'   Set altitude as rational with denominator = 1
    rAlt.Numerator = Altitude
    rAlt.Denominator = 1

    IP.Filters(1).Properties("Value") = rAlt
    Set Img = IP.Apply(Img)
'   End of writing Altitude to Image file
'   ----------------------------------
'
'   Writing Longitude, Latitude and Altitude to image file is finnished, now save the file as a new file...
    NewFile = "New_" & Dir(myFile)
    NewFile = Replace(myFile, Dir(myFile), NewFile)
    Img.SaveFile NewFile
End Sub
'
Function Convert_LatLon(Decimal_Deg As Double, Degrees As Integer, Minutes As Integer, Seconds As Double)
    Degrees = Int(Decimal_Deg)
    Minutes = Int((Decimal_Deg - Degrees) * 60)
    Seconds = ((Decimal_Deg - Degrees) * 60 - Minutes) * 60
End Function

Upvotes: 0

Saurabh Badenkal
Saurabh Badenkal

Reputation: 97

what you want to do is modify imagefile tags/properties via VBA, which is not supported. Shell32.Folder only supports reading and most of the methods are read-only for Shell32.FolderItem inside a folder object.
The only way to modify the metadata is via external tool, exiftool.
but its a commandline tool so use this post to run it from excel vba.

Upvotes: 1

Related Questions