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

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

Posted by: admin April 23, 2020 Leave a comment

Questions:

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")  '

Answer:

# 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
How to&Answers:

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/")  '

Answer:

# 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.