Exiftool in VBA on 64-bit systems

[ESN]

Hello everybody and thanks for reading.

I'm working on an MSAccess based application for cataloging photos, and am wondering if anyone has come up with a version of the exiftool VBA module that's compatible with 64-bit versions of office.  I've done a ton of reworking on the module and can't seem to get it working.  I have everything running as it should except that I'm unable to read the output from exiftool - apparently the readfile windows API function is now designed to fail if reading from a pipe after the write pipe has been closed, but if the write pipe hasn't been closed the readfile function hangs indefinitely (waiting for the write pipe tobe closed, I assume) and crashes access.  In the 32-bit version readfile works fine after the write pipe has been closed with CloseHandle.

Any advice is greatly appreciated,
-Eric

[Phil Harvey]

Hi Eric,

I will reply even though I don't know the answer to suggest that you post this question to a VBA forum because there may not be many people here who can answer this.

- Phil

[ESN]

Hi Phil,

I appreciate your taking the time to reply, and all the time you've dedicated to creating and maintaining exiftool.  I've tried asking around on a few VBA forums and have gotten nowhere, so I thought I would try here.  From more searching on MSDN it seems many other developers have run into similar issues with readfile function, and solutions are hard to come by.  At this point it seems to be an issue with the Windows API.

Thanks again,
Eric

[Skippy]

Hi Eric
I am working a similar project in ms-access 32 bit and have gone the -json route.  Currently I am writing an importer for the json data.  It seems to me that the json data from exiftool will always be flat (with no nested elements) so I am just processing it line by line in a simple script.  The other means of control that I have is to only sent tags to the json file that I want, so if there any nasty tags, I can avoid them.  Ms-access 2010 now installs at 64 bit on my newer computers so I will have to face the issue soon.  I prefer to use the fso (scripting.fileSystemObject) for working with text files, but if this fails ms-access also has an old style open file for input statements that can be used.  I have not tried working with pipes.
Cheers
Skippy

[Phil Harvey]

Hi Skippy,

The -json output (all ExifTool console output in fact) is flat unless you use the -struct option.

- Phil

[Skippy]

Here is VBA function for getting a json file with the tags you want and another function for reading the json file into a database.  There is another VBA json parser out there but it seems to be designed for non-flat json files.  It is quite complex so I thought I would write a simple version for creating flat json files and then importing them.  The code is written to work with an ms-access back end and a SQL Server back end.  I have tested the code on my machine with one dataset and it works but test it yourself before use.

Code Select Expand


Option Compare Database
Option Explicit

'Reads selected EXIF tags from from all files in a folder
'Put the cursor in the code and press F5 to run
Public Function ExifTool_FolderReader()

    Dim start As Date   
    Dim instruction As Double
    Dim cmd As String   
    Dim ExifTool As String
    Dim FileArgs As String   
    Dim OutputFile As String
    Dim OutputFolder As String
    Dim Tags As String
    Dim quote As String:  quote = Chr$(34)

   
    'Hard wired target folder for development testing
    Dim Folder As String   
Folder = "E:\DCIM\141_0604"
   
    'Initial assignments
    ExifTool = Application.CurrentProject.path & "\" & "exiftool.exe" & Space(1)
    'you *must* put exiftools into the same folder as your ms-access mdb/accdb file, to use this code as is.
    OutputFolder = Application.CurrentProject.path
    OutputFile = OutputFolder & "\out.json"

    FileArgs = " -json " & Folder & " > " & OutputFile
   
    'Make a list of the tags you want
    Tags = _
    "-Description " & _
    "-Title " & _
    "-Creator " & _
    "-Subject " & _
    "-Source " & _
    "-Credit " & _
    "-FileName " & _
    "-FileSize " & _
    "-Flash "  ' add other tags to list as required

    cmd = "cmd /c " & ExifTool & Tags & FileArgs  'shell to the cmd window app, not directly to exiftool
    Debug.Print cmd
    instruction = Shell(cmd)
   
    'Simple way to wait until exiftools exits
    MsgBox "Please wait till DOS window on taskbar closes before proceeding", vbInformation
   
    ExifTool_FolderReader = "Done"

End Function

'This code was written in ms-access 2010
Public Sub ReadExifToolJSON(Optional FileSpec As String)

    Dim fso As Object
    Dim f As Object
    Dim dbs As Database
    Dim rst As Recordset
   
    Dim text As String
    Dim tag As String
    Dim SQL As String
    Dim arr As Variant
    Dim value As Variant
   
    'Initial assignments
    'FileSpec is the name of the json file you want to import into a database
    Set fso = CreateObject("Scripting.FileSystemObject")
    FileSpec = Application.CurrentProject.path & "\out.json"
   
    'Open a recordset but don't load any records as we only want to append
    SQL = "SELECT * FROM tblExifData WHERE FALSE"
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset(SQL, dbOpenDynaset, dbSeeChanges)  'dbseechanges is required if your table is a linked SQL Server table
   
    'Validate inputs
    If Not fso.FileExists(FileSpec) Then
        MsgBox "Can't find json file", vbExclamation
        GoTo exitproc
    End If
   
    'Read from the file
    Set f = fso.opentextfile(FileSpec)

    Do While f.AtEndOfStream <> True
        text = f.readline
       
        'Detect a new record
        If Right(text, 1) = "{" Then
            'Add a new record (Access and SQL Server safe way)
            rst.AddNew
            rst.Update
            rst.Bookmark = rst.LastModified
        End If
       
        'Import a line of text, split it into an array on the : character
        If InStr(text, ":") Then
            arr = Split(text, ":")
            tag = Trim(arr(0)) 'strip off white space
            tag = Replace(tag, Chr$(34), "") 'strips of unwanted double quotes.
            value = Trim(arr(1))
            value = Replace(value, Chr$(34), "")

            rst.Edit
           
            'Pick the tags you want to read here - you will need to manually add fields to the table for each tag you want.

            Select Case tag
                Case "FileName"
                    rst!FileName = value
                Case "FileSize"
                    rst!FileSize = value
                Case "Flash"
                    rst!Flash = value
                'Case ...
                    'add in other tags
                Case Else
            End Select
            rst.Update
        End If
    Loop
    f.Close

    Debug.Print "Done"
   
exitproc:
    rst.Close: Set rst = Nothing
    dbs.Close: Set dbs = Nothing

End Sub


[Skippy]

Regarding, reading a json file and using the values to update a database record, the code in my previous post fails in some circumstances so I have re-written it to be more robust.  The failures included:

• Split between key/value pairs being in wrong place if their was a colon in the data;
• Not handling internal quotes; and
• Not dealing with escaped characters.

I have looked at a number of json parsers and they are complex and mostly depend on external libraries and finally return data in a form like a html DOM object.  There was not much inspiration there and to be direct, reading the code to see what it does is really hard work. 

In the code below, I load the values into the fields of a user defined type (~Struct), which means that the data type conversions happen before I try to update the data table with them.  It is an extra step but I can load all the values for a data table row into the Struct which make debugging easier.

If the code is useful or there is a better way, leave a note.

Code Select Expand


'This code was written in ms-access 2010
Public Sub ReadExifTagsFromJSON(DriveFolderID As Long, JsonFileSpec As String)

    '///Reads a flat json file that was created by by Exiftool
    '///Updates key exif tag data for the photos which are in the folder identified by the DriveFolderID
    '///Can only read tags that are written into the 'select case' statement in this proceedure

    Dim fso As Object
    Dim f As Object
    Dim dbs As Database
    Dim rst As Recordset
    Dim bt As BasicTags 'Type
   
    Dim Text As String
    Dim Separator As Long
    Dim tag As String
    Dim value As Variant
    Dim SQL As String
   
    'Initial assignments
    If No(JsonFileSpec) Then
        JsonFileSpec = Application.CurrentProject.path & "\FolderMetaData.json"
    End If
   
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    'Open a recordset which lists all the photos in a folder
    SQL = "SELECT * FROM tblDrivePhotos WHERE DriveFolderID = " & DriveFolderID & ";"
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset(SQL, dbOpenDynaset, dbSeeChanges)  'dbseechanges is required if your table is a linked SQL Server table
   
    'Validate inputs
    If Not fso.FileExists(JsonFileSpec) Then
        MsgBox " Can't find input json file "
        GoTo exitproc
    End If
   
    'Read from the file
    Set f = fso.opentextfile(JsonFileSpec)

    Do While f.AtEndOfStream <> True
        Text = f.readline
       
        'Detect a new record
        If Right(Text, 2) = "}," Or Right(Text, 2) = "}]" Then
            If Have(bt.FileName) Then
                With rst
                .FindFirst "FileName = '" & bt.FileName & "'"
                If Not .NoMatch Then
                    .Edit
                    If Have(bt.ImageUniqueID) Then !ImageUniqueID = bt.ImageUniqueID
                    If Have(bt.Description) Then !Description = bt.Description
                    If Have(bt.GPSLongitude) Then !Longitude = bt.GPSLongitude
                    If Have(bt.GPSLatitude) Then !Latitude = bt.GPSLatitude
                    .Update
                Else
                    Debug.Print "File: " & bt.FileName & " not found"
                End If
                'Clear old data
                bt.ImageUniqueID = ""
                bt.Description = ""
                bt.GPSLongitude = 0
                bt.GPSLatitude = 0
                End With
            End If
        End If
       
        Separator = InStr(Text, ":")
        If Separator > 0 Then
            tag = Trim(Mid(Text, 1, Separator - 1)) 'strip off white space
            tag = Replace(tag, Chr$(34), "") 'strips of unwanted double quotes.
            value = Trim(Mid(Text, Separator + 1))
            If Right(value, 1) = "," Then value = Left(value, Len(value) - 1) 'remove trailing comma
            If Left(value, 1) = Chr$(34) And Right(value, 1) = Chr$(34) Then value = Mid(value, 2, Len(value) - 2) 'strip enclosing quotes
            value = Replace(value, """", "'") 'replace internal quotes
            value = Replace(value, "\/", "/") 'remove other excape sequences
            value = Replace(value, "\\", "\")
            value = Replace(value, "\n", vbNewLine)
           
            'Pick the tags you want to read here
            Select Case tag
                Case "FileName"
                    bt.FileName = value
                Case "GPSLongitude"
                    bt.GPSLongitude = value
                Case "GPSLatitude"
                    bt.GPSLatitude = value
                Case "ImageUniqueID"
                    bt.ImageUniqueID = value
                Case "Description"
                    bt.Description = value
            End Select
        End If
       
    Loop
    f.Close
   
exitproc:
    rst.Close: Set rst = Nothing
    dbs.Close: Set dbs = Nothing

End Function


[Phil Harvey]

Parsing JSON is extremely simple.  The syntax is fully explained here.

A JSON string starts with a quote and may contain certain characters escaped with a backslash.

- Phil

[Skippy]

Thanks Phil,

I am happy to code my own procedural solutions but there is a move towards more declarative forms of coding and I suspect that is why people prefer to use a json parsing library.  A library that VBA users often use is a library that is part of Internet Explorer.  The other reason for using a json parsing library might be that it converts json into objects, however I am still in the procedural code camp so that does not suit my style.  A final determining factor might be that handling an internal double quote in VBA is almost impossible.  I was defeated by the format of a gps coordinate such "145 deg 41' 51.67\" E".  I can't figure out how to load that string into a variable so that I can work with it.  Fortunately, you have included the -n option for converting coordinates to decimal degrees. 

S