Option Explicit
Public Enum PropertyNameEnum
EXIFImageDateTimeOriginal = 36867
EXIFImageTitle = 40091
EXIFImageComments = 40092
EXIFImageAuthor = 40093
EXIFImageKeywords = 40094
EXIFImageSubject = 40095
GPSVer = 0 ' Version of the Global Positioning Systems (GPS) IFD, given as 2.0.0.0. This tag is mandatory when the GpsIFD tag is present. When the version is 2.0.0.0, the tag value is 0x02000000.
GPSLatitudeRef = 1 ' Null-terminated character string that specifies whether the latitude is north or south.: N: specifies north latitude, and: S: specifies south latitude.
GPSLatitude = 2 ' Latitude. Latitude is expressed as three rational values giving the degrees, minutes, and seconds respectively. When degrees, minutes, and seconds are expressed, the format is dd/1, mm/1, ss/1. When degrees and minutes are used and, for example, fractions of minutes are given up to two decimal places, the format is dd/1, mmmm/100, 0/1.
GPSLongitudeRef = 3 ' Null-terminated character string that specifies whether the longitude is east or west longitude.: E: specifies east longitude, and: W: specifies west longitude.
GPSLongitude = 4 ' Longitude. Longitude is expressed as three rational values giving the degrees, minutes, and seconds respectively. When degrees, minutes and seconds are expressed, the format is ddd/1, mm/1, ss/1. When degrees and minutes are used and, for example, fractions of minutes are given up to two decimal places, the format is ddd/1, mmmm/100, 0/1.
GPSAltitudeRef = 5 ' Reference altitude, in meters.
GPSAltitude = 6 ' Altitude, in meters, based on the reference altitude specified by GpsAltitudeRef.
GPSGPSTime = 7 ' Time as Coordinated Universal Time (UTC). The value is expressed as three rational numbers that give the hour, minute, and second.
GPSGPSSatellites = 8 ' Null-terminated character string that specifies the GPS satellites used for measurements. This tag can be used to specify the ID number, angle of elevation, azimuth, SNR, and other information about each satellite. The format is not specified. If the GPS receiver is incapable of taking measurements, the value of the tag must be set to: NULL.
GPSGPSStatus = 9 ' Null-terminated character string that specifies the status of the GPS receiver when the image is recorded.: A: means measurement is in progress, and: V: means the measurement is Interoperability.
GPSGPSMeasureMode = 10 ' Null-terminated character string that specifies the GPS measurement mode.: 2: specifies 2-D measurement, and: 3: specifies 3-D measurement.
GPSGPSDop = 11 ' GPS DOP (data degree of precision). An HDOP value is written during 2-D measurement, and a PDOP value is written during 3-D measurement.
GPSSpeedRef = 12 ' Null-terminated character string that specifies the unit used to express the GPS receiver speed of movement.: K,: M, and: N: represent kilometers per hour, miles per hour, and knots respectively.
GPSSpeed = 13 ' Speed of the GPS receiver movement.
GPSTrackRef = 14 ' Null-terminated character string that specifies the reference for giving the direction of GPS receiver movement.: T: specifies true direction, and: M: specifies magnetic direction.
GPSTrack = 15 ' Direction of GPS receiver movement. The range of values is from 0.00 to 359.99.
GPSImgDirRef = 16 ' Null-terminated character string that specifies the reference for the direction of the image when it is captured.: T: specifies true direction, and: M: specifies magnetic direction.
GPSImgDir = 17 ' Direction of the image when it was captured. The range of values is from 0.00 to 359.99.
GPSMapDatum = 18 ' Null-terminated character string that specifies geodetic survey data used by the GPS receiver. If the survey data is restricted to Japan, the value of this tag is: TOKYO: or: WGS-84.
GPSDestLatRef = 19 ' Null-terminated character string that specifies whether the latitude of the destination point is north or south latitude.: N: specifies north latitude, and: S: specifies south latitude.
GPSDestLat = 20 ' Latitude of the destination point. The latitude is expressed as three rational values giving the degrees, minutes, and seconds respectively. When degrees, minutes, and seconds are expressed, the format is dd/1, mm/1, ss/1. When degrees and minutes are used and, for example, fractions of minutes are given up to two decimal places, the format is dd/1, mmmm/100, 0/1.
GPSDestLongRef = 21 ' Null-terminated character string that specifies whether the longitude of the destination point is east or west longitude.: E: specifies east longitude, and: W: specifies west longitude.
GPSDestLong = 22 ' Longitude of the destination point. The longitude is expressed as three rational values giving the degrees, minutes, and seconds respectively. When degrees, minutes, and seconds are expressed, the format is ddd/1, mm/1, ss/1. When degrees and minutes are used and, for example, fractions of minutes are given up to two decimal places, the format is ddd/1, mmmm/100, 0/1.
GPSDestBearRef = 23 ' Null-terminated character string that specifies the reference used for giving the bearing to the destination point.: T: specifies true direction, and: M: specifies magnetic direction.
GPSDestBear = 24 ' Bearing to the destination point. The range of values is from 0.00 to 359.99.
GPSDestDistRef = 25 ' Null-terminated character string that specifies the unit used to express the distance to the destination point. K, M, and N represent kilometers, miles, and knots respectively.
GPSDestDist = 26 ' Distance to the destination point.
DocumentName = 269 ' Null-terminated character string that specifies the name of the document from which the image was scanned.
ImageDescription = 270 ' Null-terminated character string that specifies the title of the image.
EquipMake = 271 ' Null-terminated character string that specifies the manufacturer of the equipment used to record the image.
EquipModel = 272 ' Null-terminated character string that specifies the model name or model number of the equipment used to record the image.
StripOffsets = 273 ' For each strip, the byte offset of that strip. See also: RowsPerStrip: and: StripBytesCount.
Orientation = 274 ' Image orientation viewed in terms of rows and columns.
End Enum
Private Enum WIAImagePropertyType
UndefinedImagePropertyType = 1000
ByteImagePropertyType = 1001
StringImagePropertyType = 1002
UnsignedIntegerImagePropertyType = 1003
LongImagePropertyType = 1004
UnsignedLongImagePropertyType = 1005
RationalImagePropertyType = 1006
UnsignedRationalImagePropertyType = 1007
VectorOfUndefinedImagePropertyType = 1100
VectorOfBytesImagePropertyType = 1101
VectorOfUnsignedIntegersImagePropertyType = 1102
VectorOfLongsImagePropertyType = 1103
VectorOfUnsignedLongsImagePropertyType = 1104
VectorOfRationalsImagePropertyType = 1105
VectorOfUnsignedRationalsImagePropertyType = 1106
End Enum
Const TargetFileName = "C:\UseYourFilePath\Filename.jpg"
Sub Test_WriteProperties()
Dim NewFileName As String
NewFileName = WriteEXIFData(TargetFileName, EXIFImageTitle, "Something Somewhere", True, True)
WriteEXIFData NewFileName, EXIFImageAuthor, "Who took the picture?"
WriteEXIFData NewFileName, EXIFImageSubject, "The Photo by Whoever"
WriteEXIFData NewFileName, EXIFImageComments, "The Source: https://mrexcel.com/"
Debug.Print NewFileName
End Sub
Public Function GetEXIFData(ByVal filename As String, ByVal PropertyName As PropertyNameEnum) As String
Dim Image As Object
Dim ImageProperty As Object
Dim Result As String
Set Image = CreateObject("WIA.ImageFile")
Image.LoadFile filename
For Each ImageProperty In Image.Properties
If ImageProperty.PropertyID = PropertyName Then
If TypeName(ImageProperty.Value) = "String" Then
Result = ImageProperty.Value
Else
Result = Replace(StrConv(ImageProperty.Value.BinaryData, vbUnicode), Chr(0), "")
End If
Exit For
End If
Next
GetEXIFData = Result
Set Image = Nothing
Set ImageProperty = Nothing
End Function
Public Function WriteEXIFData(ByVal filename As String, ByVal PropertyName As PropertyNameEnum, ByVal PropertyValue As Variant, Optional ByVal OverWriteOriginal As Boolean = True, Optional ByVal CreateBackup As Boolean)
Dim Image As Object
Dim ImageProcess As Object
Dim ImageVector As Object
Dim NewFileName As String
If CreateBackup = True Then
Dim BackUpFilename As String
BackUpFilename = Replace(filename, ".jpg", "_BACKUP(" & format(Now, "ddmmyyyy-hhnn") & ").jpg")
FileCopy filename, BackUpFilename
End If
Set Image = CreateObject("WIA.ImageFile")
Set ImageProcess = CreateObject("WIA.ImageProcess")
Set ImageVector = CreateObject("WIA.Vector")
Image.LoadFile filename
ImageProcess.Filters.Add ImageProcess.FilterInfos("Exif").FilterID
ImageProcess.Filters(1).Properties("ID") = PropertyName
Select Case PropertyName
Case PropertyNameEnum.EXIFImageDateTimeOriginal
Dim StringValue As String
StringValue = format(PropertyValue, "YYYY:MM:DD HH:MM:SS")
ImageProcess.Filters(1).Properties("Type") = StringImagePropertyType
ImageProcess.Filters(1).Properties("Value") = StringValue
Case Else
ImageProcess.Filters(1).Properties("Type") = VectorOfBytesImagePropertyType
ImageVector.SetFromString PropertyValue
ImageProcess.Filters(1).Properties("Value") = ImageVector
End Select
Set Image = ImageProcess.Apply(Image)
If OverWriteOriginal = True Then
NewFileName = filename
Kill filename
Else
NewFileName = Replace(filename, ".jpg", "_metadata.jpg")
If Len(Dir(NewFileName)) > 0 Then Kill NewFileName
End If
Image.SaveFile NewFileName
WriteEXIFData = NewFileName
Set Image = Nothing
Set ImageProcess = Nothing
Set ImageVector = Nothing
End Function