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

Question

Guided by Jzz and David on another post, I discovered a VBA userform and modules that can be imported to Access DB or Excel that will ask you to select a file and it will display the EXIF external info of that file particularly GPS Longitude, Latitude, and Altitude.

My question is how do I convert this so it opens a folder instead and retrieves the GPS info on each of the files in that folder. I know it may need to loop through the contents of a folder but I have no idea how to convert this. Please see attached file and open it as Access DB. I was only able to transfer it to Excel but the code was written in too many extra calls and functions I couldn't understand right away. It would be nice to be able to modify it and make it shorter.

EXIFReader

Sarah

EDIT Thanks to David, here's my modified version:

Sub OpenFromFolder()

On Error GoTo ExifError

    Dim strDump As String
    'Dim fso As Scripting.FileSystemObject
    'Dim fldr As Scripting.Folder
    'Dim file As Scripting.file

    Set fso = CreateObject("scripting.filesystemobject")
    Set fldr = fso.GetFolder("C:/Users/JayP/Downloads/Camera Uploads/Pics")  '#### 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)
                currrow = Sheet1.UsedRange.Rows.Count + 1
                Sheet1.Range("A" & currrow).Value = "GPSLatitudeDecimal:        " & .GPSLatitudeDecimal
                Sheet1.Range("B" & currrow).Value = "GPSLongitudeDecimal:       " & .GPSLongitudeDecimal
                Sheet1.Range("C" & currrow).Value = "GPSAltitudeDecimal:        " & .GPSAltitudeDecimal
           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

Answer 1

That is fairly sophisticated code -- written by Wayne Phillips who is a certified Microsoft MVP. While it might be nice to make the code more human-readable, I suspect it is already quite optimized.

I am posting this answer because it's an interesting question/application, normally I would say "Show me what you have tried so far" but given the relative complexity of Wayne's code, I'll waive that requirement. HOWEVER the additional caveat is that I won't answer a dozen follow-up questions on this code to teach you how to use VBA. This code is tested and it works.

There is an unused function call that allows you to open from a path, we are going to use this in a loop, over the files in a specified folder.

Function OpenFile(ByVal FilePath As String) As GPSExifProperties
    Set OpenFile = m_ClassFactory.OpenFile(FilePath)
End Function

1. Import the Class Modules from Wayne's code in to your workbook's VBProject (I think you have already done this).

2. Create a new subroutine like the one below, in a normal code module.

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("C:/users/david_zemens/desktop/")  '#### 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

You need to modify this:

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

And also this. I assume you already know how to put the data in a worksheet or display it on a form, etc. This line only prints to the console in the Immediate window of the VBA, it will not write to a worksheet/etc. unless you modify it to do so. That is not part of the question, so I will leave that up to you to work out :)

Debug.Print strDump 

NOTE: I removed some object variables that you won't have in Excel, and added some new variables to do the Folder/Files iteration. I put in simple error handling to inform you of errors (msgbox) and resume the next file. In my testing, the only error I got was some files do not have EXIF data.