Excel VBA open folder and get GPS info (Exif) of each files in it (2)

Question

I'm trying to retrieve Exif metadata from jpg files (GPS Latitude and Longitude data, embedded in pictues taken with a Nikon Coolpix W300 camera), using the Wayne Phillips Class Modules Code (EXIFReader access application), and David Zemens subroutine suggestioned on "Excel VBA open folder and get GPS info (Exif) of each files in it" post (link of the original post: How to obtain EXIF info from picture in an excel worksheet using VBA).

Guided by David answare, I've tried all he had proposed:

1) I imported the Class Modules from Wayne's Code into my workbook project;

2) In the Class Modules, I've modified the declared functions, making it compatible with Excel 64 bits, using "PtrSafe" declaration;

3) I created a subroutine exactly like David has proposed, on a normal code module;

4) I've updated the folder path to the correct one

(Set fldr=fso.GetFolder("C:/users/david_zemens/desktop/"));

5) I've compiled and debugged the project and I've faced an Application crash when the code was up to run the instruction below, stored in GPSExifProperties Class Module:

Property Get GPSLatitudeDecimal() As Variant Call **VCOMObject**.AssignVar(GPSLatitudeDecimal, VCOMObject.GPSLatitudeDecimal) End Property

Wayne's Class Modules Code can be found in this link: https://www.everythingaccess.com/tutorials.asp?ID=Extracting-GPS-data-from-JPEG-files

David Zemens Code, that I'm trying to use is below:

Sub OpenFromFolder()

On Error GoTo ExifError

    Dim strDump As String
    '## REQUIRES REFERENCE TO MICROSOFT SCRIPTING RUNTIME
    Dim fso As Scripting.FileSystemObject
    Dim fldr As Scripting.Folder
    Dim file As Scripting.file

    Set fso = CreateObject("scripting.filesystemobject")
    Set fldr = fso.GetFolder("E:\DNIT\Relatório Fotográfico\Fotos com dados GPS")  '#### Modify this to your folder location

    For Each file In fldr.Files
    '## ONLY USE JPG EXTENSION FILES!!
    Select Case UCase(Right(file.Name, 3))
        Case "JPG"
            With GPSExifReader.OpenFile(file.Path)

               strDump = strDump & "FilePath:                  " & .FilePath & vbCrLf
               strDump = strDump & "DateTimeOriginal:          " & .DateTimeOriginal & vbCrLf
               strDump = strDump & "GPSVersionID:              " & .GPSVersionID & vbCrLf
               strDump = strDump & "GPSLatitudeDecimal:        " & .GPSLatitudeDecimal & vbCrLf
               strDump = strDump & "GPSLongitudeDecimal:       " & .GPSLongitudeDecimal & vbCrLf
               strDump = strDump & "GPSAltitudeDecimal:        " & .GPSAltitudeDecimal & vbCrLf
               strDump = strDump & "GPSSatellites:             " & .GPSSatellites & vbCrLf
               strDump = strDump & "GPSStatus:                 " & .GPSStatus & vbCrLf
               strDump = strDump & "GPSMeasureMode:            " & .GPSMeasureMode & vbCrLf
               strDump = strDump & "GPSDOPDecimal:             " & .GPSDOPDecimal & vbCrLf
               strDump = strDump & "GPSSpeedRef:               " & .GPSSpeedRef & vbCrLf
               strDump = strDump & "GPSSpeedDecimal:           " & .GPSSpeedDecimal & vbCrLf
               strDump = strDump & "GPSTrackRef:               " & .GPSTrackRef & vbCrLf
               strDump = strDump & "GPSTrackDecimal:           " & .GPSTrackDecimal & vbCrLf
               strDump = strDump & "GPSImgDirectionRef:        " & .GPSImgDirectionRef & vbCrLf
               strDump = strDump & "GPSImgDirectionDecimal:    " & .GPSImgDirectionDecimal & vbCrLf
               strDump = strDump & "GPSMapDatum:               " & .GPSMapDatum & vbCrLf
               strDump = strDump & "GPSDestLatitudeDecimal:    " & .GPSDestLatitudeDecimal & vbCrLf
               strDump = strDump & "GPSDestLongitudeDecimal:   " & .GPSDestLongitudeDecimal & vbCrLf
               strDump = strDump & "GPSDestBearingRef:         " & .GPSDestBearingRef & vbCrLf
               strDump = strDump & "GPSDestBearingDecimal:     " & .GPSDestBearingDecimal & vbCrLf
               strDump = strDump & "GPSDestDistanceRef:        " & .GPSDestDistanceRef & vbCrLf
               strDump = strDump & "GPSDestDistanceDecimal:    " & .GPSDestDistanceDecimal & vbCrLf
               strDump = strDump & "GPSProcessingMethod:       " & .GPSProcessingMethod & vbCrLf
               strDump = strDump & "GPSAreaInformation:        " & .GPSAreaInformation & vbCrLf
               strDump = strDump & "GPSDateStamp:              " & .GPSDateStamp & vbCrLf
               strDump = strDump & "GPSTimeStamp:              " & .GPSTimeStamp & vbCrLf
               strDump = strDump & "GPSDifferentialCorrection: " & .GPSDifferentialCorrection & vbCrLf

               Debug.Print strDump   '## Modify this to print the results wherever you want them...

           End With
       End Select
    NextFile:
        Next
        Exit Sub

    ExifError:
        MsgBox "An error has occurred with file: " & file.Name & vbCrLf & vbCrLf & Err.Description
        Err.Clear
        Resume NextFile

    End Sub

Debugging it, when the code is up to run the 4th line into the With/End With block, with the ".GPSLatitudeDecimal" instruction, the Application crashes. It does not come with an error message before closing the excel application. I'd like to understand what's going wrong with this code and how can I fix it and retrieve the GPS metadata I need to make my monthly photo reports.

Answer 1

Try to get GPS coords from EXIF data using WIA.ImageFile, here is the example:

Sub Test()

    With CreateObject("WIA.ImageFile")
        .LoadFile "C:\Test\image.jpg"
        With .Properties("GpsLatitude").Value
            Debug.Print .Item(1).Value + .Item(2).Value / 60 + .Item(3).Value / 3600
        End With
        With .Properties("GpsLongitude").Value
            Debug.Print .Item(1).Value + .Item(2).Value / 60 + .Item(3).Value / 3600
        End With
    End With

End Sub

Answer 2

There is nothing wrong with the code you posted. I successfully ran it using sample images from GitHub. My guess is you did not correctly insert ptrSafe to convert to 64bit. The sample from Wayne's site already has all of the 64bit declarations.

#If VBA7 = False Then
    Private Declare Function VirtualAlloc Lib "kernel32" (ByVal Address As Long, ByVal Size As Long, ByVal AllocationType As Long, ByVal Protect As Long) As Long
    Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal ProcName As String) As Long
    Private Declare Function GetProcAddress Lib "kernel32" (ByVal Module As Long, ByVal ProcName As String) As Long
    Private Declare Sub CopyMemoryAnsi Lib "kernel32" Alias "RtlMoveMemory" (ByVal Dest As Long, ByVal Source As String, ByVal Size As Long)
    Private Declare Sub CastToObject Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As Object, ByRef Source As Long, ByVal Size As Long)

    Private Type IDispatchVTable
        QueryInterface As Long
        AddRef As Long
        Release As Long
        GetTypeInfoCount As Long
        GetTypeInfo As Long
        GetIDsOfNames As Long
        Invoke As Long
    End Type
#Else
    Private Declare PtrSafe Function VirtualAlloc Lib "kernel32" (ByVal Address As LongPtr, ByVal Size As LongPtr, ByVal AllocationType As Long, ByVal Protect As Long) As LongPtr
    Private Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal ProcName As String) As LongPtr
    Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal Module As LongPtr, ByVal ProcName As String) As LongPtr
    Private Declare PtrSafe Sub CopyMemoryAnsi Lib "kernel32" Alias "RtlMoveMemory" (ByVal Dest As LongPtr, ByVal Source As String, ByVal Size As LongPtr)
    Private Declare PtrSafe Sub CastToObject Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As Object, ByRef Source As LongPtr, ByVal Size As LongPtr)

    Private Type IDispatchVTable
        QueryInterface As LongPtr
        AddRef As LongPtr
        Release As LongPtr
        GetTypeInfoCount As LongPtr
        GetTypeInfo As LongPtr
        GetIDsOfNames As LongPtr
        Invoke As LongPtr
    End Type
#End If

I opened the mdb file, exported the 3 class modules, and reimported them into Excel file without any modifications whatsoever.