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
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
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
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
Hi Skippy,
The -json output (all ExifTool console output in fact) is flat unless you use the -struct option.
- Phil
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.
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
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.
'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
Parsing JSON is extremely simple. The syntax is fully explained here (http://www.json.org).
A JSON string starts with a quote and may contain certain characters escaped with a backslash.
- Phil
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