Reading IPTC metadata in JPEGs (2 Viewers)

[jray9242]

I have searched and search with no luck. I have a Access 2010 table that has links to all my pictures (jpgs) and I want to read in the IPTC metadata and display it on the form.

I found the following code but get errors with the SHELL32 section.

I call the program this way and this is the code I am using.

Any help and direction would be helpful shinning some light on it.

Thank you

Jim

Button: Call getFileMetadata("C:\pictures", "mypicture.jpg", "photo")

Option Compare Database

Public Function getFileMetadata(fileFolder As String, fileNm As String, metadataType As String) As String

Dim objShell As New SHELL32.Shell
Dim objFolder As New SHELL32.Folder
Dim objFolderItem As New SHELL32.FolderItem

Set objShell = New Shell
Set objShell = CreateObject("Shell.application")
Set objFolder = objShell.Namespace(fileFolder)
Set objFolderItem = objFolder.ParseName(fileNm)


'I WAS USING THIS FOR .JPG FILES
If metadataType = "photo" Then
Dim cTxt As String
cTxt = "Dimensions: " & objFolder.GetDetailsOf(objFolderItem, 26)
cTxt = cTxt & vbCrLf & "Date Picture Taken: " & _
objFolder.GetDetailsOf(objFolderItem, 25)
cTxt = cTxt & vbCrLf & "Camera Model: " & _
objFolder.GetDetailsOf(objFolderItem, 24)
cTxt = cTxt & vbCrLf & "Type: " & _
objFolder.GetDetailsOf(objFolderItem, 2)
cTxt = cTxt & vbCrLf & "Size: " & _
objFolder.GetDetailsOf(objFolderItem, 1)
getFileMetadata = cTxt
ElseIf metadataType = "DatePicTaken" Then
getFileMetadata = objFolder.GetDetailsOf(objFolderItem, 25)
Else
getFileMetadata = objFolder.GetDetailsOf(objFolderItem, 1)
End If


Set objFolderItem = Nothing
Set objFolder = Nothing
Set objShell = Nothing


'Properties and index:
'================
'0 Name
'1 Size
'2 Type
'3 Date Modified
'4 Date Created
'5 Date Accessed
'6 Attributes
'7 Status
'8 Owner
'9 Author
'10 Title
'11 Subject
'12 Category
'13 Pages
'14 Comments
'15 Copyright
'16 Artist
'17 Album Title
'18 YEAR
'19 Track Number
'20 Genre
'21 Duration
'22 Bit Rate
'23 Protected
'24 Camera Model
'25 Date Picture Taken
'26 Dimensions
'27
'28
'29 Episode Name
'30 Program Description
'31
'32 Audio sample size
'33 Audio sample rate
'34 Channels
'35 Company
'36 Description
'37 File Version
'38 Product Name
'39 Product Version
'40 Keywords


End Function

 

[MarkK]

I found the following code but get errors with the SHELL32 section.

Hi there. It matters what the exact errors are, and exactly where they occur.

 

[jray9242]

Sorry about that.

Line: Dim objShell As New SHELL32.Shell

Error:

Complier error

user-defined type not defined

 

[MarkK]

You have two choices, you can...
1) set a reference to the Shell32 object model. Open the references selector and scroll down to an item called: Microsoft Shell Controls and Automation. Click the checkbox next to that item, and in this case you don't need the New keyword in your declarations (because your code later on creates the objects anyway)

Dim objShell As SHELL32.Shell
Dim objFolder As SHELL32.Folder
Dim objFolderItem As SHELL32.FolderItem

-or-
2) Change the code to be late bound, so you don't make any explicit reference to the Shell32 object model, like...

Dim objShell As Object  [COLOR="Green"]' New SHELL32.Shell[/COLOR]
Dim objFolder As Object  [COLOR="green"]' New SHELL32.Folder[/COLOR]
Dim objFolderItem As Object  [COLOR="green"]' New SHELL32.FolderItem[/COLOR]

hth

 

[jray9242]

Here is what I did
Dim objShell As Object ' New SHELL32.Shell
Dim objFolder As Object ' New SHELL32.Folder
Dim objFolderItem As Object ' New SHELL32.FolderItem

' Set objShell = New Shell

Set objShell = CreateObject("Shell.application")
Set objFolder = objShell.Namespace(fileFolder)
Set objFolderItem = objFolder.ParseName(fileNm) <<<<< object variable or with block variable not set

I am hoping once I get past this, all will work. I am doing a lot of Googling for the solution as well.

Thanks again.

 

[sneuberg]

You can get that error if the folder name is misspelled. I suggest checking the spelling and existence of "C:\pictures"

Edit: I determined this using early binding. When I switched in to late binding I found, as Mark did, that is doesn't work even if the folder name is correct.

 

[MarkK]

In a quick test I could not make this work using late binding. When I set the reference the Shell32 object library it worked fine.

In code window, go to Tools->References and scroll down to the "Microsoft Shell Controls and Automation" and set the check box. Then use code like...

Dim objShell As SHELL32.Shell
Dim objFolder As SHELL32.Folder
Dim objFolderItem As SHELL32.FolderItem

Set objShell = CreateObject("Shell.application")
Set objFolder = objShell.Namespace(fileFolder)
Set objFolderItem = objFolder.ParseName(fileNm)

...in which the declared objects are strongly typed as Shell32 objects.
Hope this helps,

 

[jray9242]

That could be a problem because I don't see Microsoft Shell Controls and Automation to select from.

How can I get it because it seems to be missing.

 

[MarkK]

What are the steps you went through to find this reference?

 

[jray9242]

I post a screen shot that I hope is helpful.

ALT-F11
Tools
Reference

 

[sneuberg]

If you scroll about half way down it's not it the list like below?

Note that you have to click on the check box to get it to stick. Just clicking on the name doesn't do it.

 

[jray9242]

That selection doesn't show it.

 

[MarkK]

Search your file system for a file called Shell32.dll. That's the file you need. Or if that has been superseded on a 64-bit system, you can start your search there with what file replaces Shell32.dll on a 64-bit system.

It might be in C:\Windows\SysWOW64\Shell32.dll. If you can find it, hit the browse button on the references dialog, navigate to the folder in questions, select the file, and see if it sets the reference that way.

 

[jray9242]

Got it now. I selected it, closed the program and started it again.

I am still getting that darn error 91 With block variable on this line:

Set objFolderItem = objFolder.ParseName(fileNm)

But now I have the Shell32 command loaded.

I also notice the following is set to nothing.

Set objFolder = objShell.Namespace(fileFolder)
Set objFolderItem = objFolder.ParseName(fileNm)

I did a watch on filefolder and fileNm and they did get passed ok.

 

[MarkK]

Can you show all your code. How are you creating your shell application? How are fileFolder and fileNm declared? And so on...

 

[sneuberg]

Can you show all your code. How are you creating your shell application? How are fileFolder and fileNm declared? And so on...

For what it's worth when I removed the word New from the declaration of the code in the original post, i,e, so they're like:

Dim objShell As Shell32.Shell
Dim objFolder As Shell32.Folder
Dim objFolderItem As Shell32.FolderItem

and added the Shell reference I was able to compile and run the code. I got the following output

Dimensions:
Date Picture Taken:
Camera Model:
Type: JPG File
Size: 2.55 MB


when I called it with

Debug.Print getFileMetadata("G:\Pictures\103NIKON", "DSCN1342.JPG", "photo")

I have Access 2013 and Windows 7.

 

[jdraw]

I tried the same set up as Steve

?getfilemetadata("c:\users\mellon\documents","dscf7986.jpg","photo")
Dimensions:
Date Picture Taken:
Camera Model:
Type: IrfanView JPG File
Size: 883 KB

I then modified the code to get all available properties as follows

' Procedure : getFileMetadata
' Author    : mellon
' Date      : 17-Mar-2017
' Purpose   :
'---------------------------------------------------------------------------------------
'
Public Function getFileMetadata(fileFolder As String, fileNm As String, metadataType As String) As String

    Dim objShell As Shell32.Shell
    Dim objFolder As Shell32.Folder
    Dim objFolderItem As Shell32.FolderItem

10  On Error GoTo getFileMetadata_Error

20  Set objShell = New Shell
30  Set objShell = CreateObject("Shell.application")
40  Set objFolder = objShell.Namespace(fileFolder)
50  Set objFolderItem = objFolder.ParseName(fileNm)


    'I WAS USING THIS FOR .JPG FILES
60  If metadataType = "photo" Then
       Dim cTxt As String
       [COLOR="Blue"] Dim i As Integer
       For i = 0 To 40
            cTxt = cTxt & vbCrLf & i & "  " & objFolder.GetDetailsOf(objFolderItem, i)
           
        Next i[/COLOR]
            '70    cTxt = "Dimensions: " & objFolder.GetDetailsOf(objFolderItem, 26)
            '80    cTxt = cTxt & vbCrLf & "Date Picture Taken: " & _
             '      objFolder.GetDetailsOf(objFolderItem, 25)
            '90    cTxt = cTxt & vbCrLf & "Camera Model: " & _
             '      objFolder.GetDetailsOf(objFolderItem, 24)
            '100   cTxt = cTxt & vbCrLf & "Type: " & _
             '      objFolder.GetDetailsOf(objFolderItem, 2)
            '110   cTxt = cTxt & vbCrLf & "Size: " & _
             '      objFolder.GetDetailsOf(objFolderItem, 1)
120         getFileMetadata = cTxt
'130     ElseIf metadataType = "DatePicTaken" Then
'140         getFileMetadata = objFolder.GetDetailsOf(objFolderItem, 25)
'150     Else
'160         getFileMetadata = objFolder.GetDetailsOf(objFolderItem, 1)
170     End If


180     Set objFolderItem = Nothing
190     Set objFolder = Nothing
200     Set objShell = Nothing


        'Properties and index:
        '================
        '0 Name
        '1 Size
        '2 Type
        '3 Date Modified
        '4 Date Created
        '5 Date Accessed
        '6 Attributes
        '7 Status
        '8 Owner
        '9 Author
        '10 Title
        '11 Subject
        '12 Category
        '13 Pages
        '14 Comments
        '15 Copyright
        '16 Artist
        '17 Album Title
        '18 YEAR
        '19 Track Number
        '20 Genre
        '21 Duration
        '22 Bit Rate
        '23 Protected
        '24 Camera Model
        '25 Date Picture Taken
        '26 Dimensions
        '27
        '28
        '29 Episode Name
        '30 Program Description
        '31
        '32 Audio sample size
        '33 Audio sample rate
        '34 Channels
        '35 Company
        '36 Description
        '37 File Version
        '38 Product Name
        '39 Product Version
        '40 Keywords


210     On Error GoTo 0
220     Exit Function

getFileMetadata_Error:

230     MsgBox "Error " & err.number & " in line " & Erl & " (" & err.Description & ") in procedure getFileMetadata of Module ModuleTesting_CanKill"
240     Exit Function

    End Function
[code]

Which resulted in:

[code]?getfilemetadata("c:\users\mellon\documents","dscf7986.jpg","photo")

0  DSCF7986.JPG
1  883 KB
2  IrfanView JPG File
3  10-Oct-2013 5:52 PM
4  23-Jul-2016 1:02 PM
5  23-Jul-2016 1:02 PM
6  A
7  
8  Available offline
9  Image
10  Lenovo-PC\mellon
11  Picture
12  ?10-?Oct-?2013 ??5:52 PM
13  
14  
15  
16  
17  
18  
19  Unrated
20  
21  
22  
23  
24  
25      
26  
27  
28  
29  
30  FinePix S5700 S700
31  ?2304 x 1728?
32  FUJIFILM
33  
34  
35  Digital Camera FinePix S5700 S700 Ver1.00
36  
37  
38  
39  
40

Here is the info for same jpg from IrfanView. Hope it's helpful

[dscf7986.jpg]
File name = dscf7986.jpg
Directory = c:\users\mellon\documents\
Compression = JPEG, quality: 91, subsampling ON (2x1)
Resolution = 72 x 72 DPI
Image dimensions = 2304 x 1728  Pixels (3.98 MPixels) (4:3)
Print size = 81.3 x 61.0 cm; 32.00 x 24.00 inches
Color depth = 16,7 Million   (24 BitsPerPixel)
Number of unique colors = 302642
Disk size = 883.47 KB (904,670 Bytes)
Current memory size = 11.39  MB (11,943,976 Bytes)
File date/time = 10-Oct-2013 / 17:52:20

- EXIF -
Make - FUJIFILM
Model - FinePix S5700 S700
Orientation - Top left
XResolution - 72
YResolution - 72
ResolutionUnit - Inch
Software - Digital Camera FinePix S5700 S700 Ver1.00
DateTime - 2013:10:10 17:52:20
YCbCrPositioning - Co-Sited
Copyright
ExifOffset - 300
ExposureTime - 1/60 seconds
FNumber - 3.50
ExposureProgram - Normal program
ISOSpeedRatings - 200
ExifVersion - 0220
DateTimeOriginal - 2013:10:10 17:52:20
DateTimeDigitized - 2013:10:10 17:52:20
ComponentsConfiguration - YCbCr
CompressedBitsPerPixel - 2.00 (bits/pixel)
ShutterSpeedValue - 1/64 seconds
ApertureValue - F 3.48
BrightnessValue - 3.70
ExposureBiasValue - 0.00
MaxApertureValue - F 3.48
MeteringMode - Multi-segment
LightSource - Auto
Flash - Flash not fired, auto mode
FocalLength - 6.30 mm
FlashPixVersion - 0100
ColorSpace - sRGB
ExifImageWidth - 2304
ExifImageHeight - 1728
InteroperabilityOffset - 984
FocalPlaneXResolution - 4032
FocalPlaneYResolution - 4032
FocalPlaneResolutionUnit - Centimeter
SensingMethod - One-chip color area sensor
FileSource - DSC - Digital still camera
SceneType - A directly photographed image
CustomRendered - Normal process
ExposureMode - Auto
White Balance - Auto
SceneCaptureType - Standard
Sharpness - Normal
SubjectDistanceRange - Unknown
Maker Note (Vendor):
Version - 30333130
Quality - NORMAL
Sharpness - Normal
White Balance - Auto
Saturation - Normal
Flash Mode - Red-eye reduction
Flash Strength - 0.00
Macro - Off
Focus mode - Auto
Slow Sync. - Off
Picture Mode - Auto
Unknown - 1
Sequence mode - Off
Unknown - 0
Blur warning - No
Focus warning - No (Focus OK)
AE warning - No (AE good)
Thumbnail:
Compression - 6 (JPG)
Orientation - Top left
XResolution - 72
YResolution - 72
ResolutionUnit - Inch
JpegIFOffset - 4084
JpegIFByteCount - 4606
YCbCrPositioning - Co-Sited

 

[jray9242]

Mark,

This is the exact way I call this.

I call the procedure from a button

Private Sub Command8_Click()
    Call getFileMetadata("C:\Users\Jim\Google Drive\Genealogy\01-People\01.1-Ray Side", "Isaac Ray Story.jpg", "photo")
End Sub

This is the code I use.

Option Explicit

Public Function getFileMetadata(fileFolder As String, fileNm As String, metadataType As String) As String

    Dim objShell As Object ' New SHELL32.Shell
    Dim objFolder As Object ' New SHELL32.Folder
    Dim objFolderItem As Object ' New SHELL32.FolderItem
    
    Set objShell = New Shell
    Set objShell = CreateObject("Shell.application")
    Set objFolder = objShell.Namespace(fileFolder)
    Set objFolderItem = objFolder.ParseName(fileNm)
    

   'I WAS USING THIS FOR .JPG FILES
    If metadataType = "photo" Then
       Dim cTxt As String
       cTxt = "Dimensions: " & objFolder.GetDetailsOf(objFolderItem, 26)
       cTxt = cTxt & vbCrLf & "Date Picture Taken: " & _
objFolder.GetDetailsOf(objFolderItem, 25)
       cTxt = cTxt & vbCrLf & "Camera Model: " & _
objFolder.GetDetailsOf(objFolderItem, 24)
       cTxt = cTxt & vbCrLf & "Type: " & _
objFolder.GetDetailsOf(objFolderItem, 2)
       cTxt = cTxt & vbCrLf & "Size: " & _
objFolder.GetDetailsOf(objFolderItem, 1)
       getFileMetadata = cTxt
     ElseIf metadataType = "DatePicTaken" Then
       getFileMetadata = objFolder.GetDetailsOf(objFolderItem, 25)
     Else
       getFileMetadata = objFolder.GetDetailsOf(objFolderItem, 1)
    End If


    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing


'Properties and index:
'================
'0 Name
'1 Size
'2 Type
'3 Date Modified
'4 Date Created
'5 Date Accessed
'6 Attributes
'7 Status
'8 Owner
'9 Author
'10 Title
'11 Subject
'12 Category
'13 Pages
'14 Comments
'15 Copyright
'16 Artist
'17 Album Title
'18 YEAR
'19 Track Number
'20 Genre
'21 Duration
'22 Bit Rate
'23 Protected
'24 Camera Model
'25 Date Picture Taken
'26 Dimensions
'27
'28
'29 Episode Name
'30 Program Description
'31
'32 Audio sample size
'33 Audio sample rate
'34 Channels
'35 Company
'36 Description
'37 File Version
'38 Product Name
'39 Product Version
'40 Keywords


End Function

 

[sneuberg]

@jdraw,

Since this works on both of our systems this appears to be a problem with jray9242's environment which appears to be Access 2010. What version of Access and operating system do you have?

@jray9242,

Same question. What version of Access and operating system do you have?

 

[MarkK]

If you have a valid reference set to Shell32, then modify your code as follows...

    Dim objShell As New SHELL32.Shell
    Dim objFolder As SHELL32.Folder
    Dim objFolderItem As SHELL32.FolderItem
    
    Set objFolder = objShell.Namespace(fileFolder)
    MsgBox "Folder Created: " & Not objFolder Is Nothing
    Set objFolderItem = objFolder.ParseName(fileNm)

See if that works. The message box will pop up and indicate whether the call to objShell.Namespace() actually created objFolder or not.