Need sample code to read caption field from Picasa 1

[BrooksR]

Picasa writes captions into JPG files into a field called IPTC.Description. I need a snipnet showing how to retrieve that text/data.

Thanks.

 

[Remou]

I am not familiar with Picasa, but some of the code below may be useful.

Sub GetDetails(FullNameAndPath As String)

'0 Retrieves the name of the item.
'1 Retrieves the size of the item.
'2 Retrieves the type of the item.
'3 Retrieves the date and time that the item was last modified.
'4 Retrieves the attributes of the item.
'-1 Retrieves the info tip information for the item.

    Dim objShell  As Shell
    Dim objFolder As Folder
    Dim f As String
    Dim fp As String
    Dim strT
    
    If Right(FullNameAndPath, 1) = "\" Then
        FullNameAndPath = Left(FullNameAndPath, Len(FullNameAndPath) - 1)
    End If
    
    f = Mid(FullNameAndPath, InStrRev(FullNameAndPath, "\") + 1)
    fp = Mid(FullNameAndPath, 1, InStrRev(FullNameAndPath, "\"))

    Set objShell = New Shell
    Set objFolder = objShell.NameSpace(fp)
    
    If (Not objFolder Is Nothing) Then
        Dim objFolderItem As folderItem
        Set objFolderItem = objFolder.ParseName(f)
   
        If (Not objFolderItem Is Nothing) Then
            Dim szItem As String
            
            For i = -1 To 4
                'Tip Info includes its own detail descriptions
                strT = Choose((i + 2), "", "Name : ", "Size : ", "Type : ", "Last Modified : ", "Attributes : ")
                szItem = objFolder.GetDetailsOf(objFolderItem, i)
                Debug.Print strT & szItem
            Next
            
        End If
        Set objFolderItem = Nothing
    End If
    
    Set objFolder = Nothing
    Set objShell = Nothing
End Sub
 

Private Sub GetExtendedDetails(FullNameAndPath As String)
'Minimum DLL version shell32.dll version 5.0 or later
'Minimum operating systems Windows 2000, Windows Millennium
'References: Microsoft Shell Controls and Automation
'More info (put on one line): [URL unfurl="true"]http://msdn.microsoft.com/library/default.asp?url=[/URL]
'/library/en-us/shellcc/platform/shell/reference/objects/shellfolderitem/
'ExtendedProperty.asp

    Dim objShell  As Shell
    Dim objFolder As Folder
    Dim ToShow As Variant
    Dim sPropName As String
    Dim f As String
    Dim fp As String
    
    If Right(FullNameAndPath, 1) = "\" Then
        FullNameAndPath = Left(FullNameAndPath, Len(FullNameAndPath) - 1)
    End If
    
    f = Mid(FullNameAndPath, InStrRev(FullNameAndPath, "\") + 1)
    fp = Mid(FullNameAndPath, 1, InStrRev(FullNameAndPath, "\"))
    
    Set objShell = New Shell
    Set objFolder = objShell.NameSpace(fp)
    
    ToShow = Split("DocTitle,Company,FileDescription,FileVersion,ProductName," _
            & "ProductVersion", ",")

    If (Not objFolder Is Nothing) Then
        Dim objFolderItem As ShellFolderItem
        Set objFolderItem = objFolder.ParseName(f)
        
        If (Not objFolderItem Is Nothing) Then
            Dim szItem As String
            For i = 0 To UBound(ToShow)
                sPropName = ToShow(i)
                szItem = sPropName & " : " & objFolderItem.ExtendedProperty(sPropName)
                Debug.Print szItem
            Next
        End If
        Set objFolderItem = Nothing
    End If
    
    Set objFolder = Nothing
    Set objShell = Nothing
End Sub

 

[BrooksR]

Thank you. Since posting the question, I found and developed:

Function GetJPGCaption(sourcefile As String) As String
Dim EXIF As aisExif.AiSEXIFReader

Set EXIF = New aisExif.AiSEXIFReader
'MsgBox EXIF.Version

Call EXIF.ReadExifInfo(sourcefile)

If EXIF.Error <> "" Then
'MsgBox "Error Encountered: " & EXIF.Error
GetJPGCaption = ""
Else
GetJPGCaption = EXIF.GetParam("ImageCaption")
End If
End Function

It requires aisexif.dll from:

http://www.watermarker.com/download.aspx

Brooks