reading data from thumnails

[michael.a7]

I have some photos and I'm creating a sheet that inventories my images.
I am inserting a photo thumbnail on the sheet and I would like excel to
read the (ITCP) data from the image such as date it was taken, Fstop,
focal length, etc. and automatically fill in the corresponding fields.

Does excel have the capability to retrieve that information from the
photo?
Thanks

 

[RB Smissaert]

Excel can't do it, but maybe there is an API for that software and maybe you
can set a
reference to it in Excel and then use the properties/methods of that API.
In the VBE look under Tools, References and see if it is available.
The other option is to open the file in binary mode and read the file.
You will then need to find out though where and how that information is
stored.

Function ReadBinaryFile(strFile As String) As Variant

Dim hFile As Long
Dim btArray() As Byte

ReDim btArray(1 To FileLen(strFile))

hFile = FreeFile

Open strFile For Binary As #hFile
Get #hFile, 1, btArray
Close hFile

ReadBinaryFile = btArray

End Function


Sub tester()

Dim i As Long
Dim arr

arr = ReadBinaryFile("C:\Image66.gif")

For i = 1 To 20
MsgBox arr(i)
Next

End Sub


RBS

 

[RB Smissaert]

Sorry, ignore the second option (the one with Function ReadBinaryFile)
as I can see now that that won't help you.

RBS

 

[Peter T]

If you are you trying to read the 'EXIF' tags in your digital photos,
download this cool class -

http://www.veign.com/vrc_codeview.asp?type=app&id=104

and drag or import the class into a vba project.

The author gave an example of usage but try this crude bit of brute in a
normal module in the same project -

Sub test2()

Dim objExif As New ExifReader
Dim txtExifInfo As String
Dim i As Long, rw As Long
Dim sFile As String
Dim v

sFile = "C:\Path_To_Jpg.jpg"

objExif.Load sFile
For i = 1 To 60000
With objExif
v = .Tag(i)
If Len(v) Then
rw = rw + 1
Cells(rw, 1) = "&H" & CStr(Hex(i))
Cells(rw, 2) = "'" & CStr(v)
End If
End With
Next
'txtExifInfo = objExif.Tag(ISOSpeedRatings)
'MsgBox txtExifInfo
End Sub

Look at the hex codes to see what info your file contains and look these up
under "Public Enum EXIF_TAG" in the class module, then make a more sensible
function to suit your needs.

Regards,
Peter T

 

[will.mansfield]

Bit of a mash from other macros but works as a quick job


Private Sub Show_Image_Date()

Dim fPath As Variant
Dim objShell As Object
Dim objFolder As Object
Dim strFileName As Object
Dim NewName As String

fPath = "C:\Documents and Settings\uksiwm\Desktop\New Folder (3)\DCIM\XPRIA"

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(fPath)

'Loop through all Items (files) in folder "C:\Files"
For Each strFileName In objFolder.Items

If InStr(strFileName, ".jpg") > 0 Then

'Ignore if EXIF missing
If Len(objFolder.GetDetailsOf(strFileName, 25)) > 0 Then

'MsgBox "Date Taken = " & objFolder.GetDetailsOf(strFileName, 25), , strFileName

NewName = Year(objFolder.GetDetailsOf(strFileName, 25)) & Right("0" & Month(objFolder.GetDetailsOf(strFileName, 25)), 2) & Right("0" & Day(objFolder..GetDetailsOf(strFileName, 25)), 2) & "_" & Right("0" & Hour(objFolder.GetDetailsOf(strFileName, 25)), 2) & Right("0" & Minute(objFolder.GetDetailsOf(strFileName, 25)), 2) & Right("0" & Second(objFolder.GetDetailsOf(strFileName, 25)), 2)
NewName = NewName
NewName = fPath & "\" & NewName & "_" & Right(strFileName, 8)

Name fPath & "\" & strFileName As NewName

End If

End If

Next

End Sub