Get GPS location data from picture files

[csenor]

Hi Forum. I'm in need of assistance with adding additional code to this VBA to get the GPS coordinates to appear in my spreadsheet. The VBA below works perfectly, but it doesn't grab the coordinates. The array (0,1,2,12,30) captures name, size, item type, date taken, and camera model. I've tested other numbers in the array, but I have not been able to get the latitude, longitude, and altitude to appear. Can anyone assist? Thank you.

The code I'm using:
-----------------------------------------------------------------------------------------------------------------------------------------------------

Option Explicit


Sub GetMetaDataFromPictureFiles()


Dim objShellApp As Object
Dim objFolder As Object
Dim varColumns As Variant
Dim arrData() As Variant
Dim wksResults As Worksheet
Dim strPath As String
Dim strFilename As String
Dim fileCount As Long
Dim i As Long
Dim j As Long

strPath = ThisWorkbook.Worksheets("Directions").Range("a2").Value

Set objShellApp = CreateObject("Shell.Application")

On Error Resume Next
Set objFolder = objShellApp.Namespace(CStr(strPath))
If objFolder Is Nothing Then
MsgBox "Folder not found!", vbExclamation, "Folder?"
Set objShellApp = Nothing
Exit Sub
End If
On Error GoTo 0

varColumns = Array(0, 1, 2, 12, 30)

ReDim arrData(0 To UBound(varColumns), 0 To objFolder.items.Count)

For i = LBound(arrData, 1) To UBound(arrData, 1)
arrData(i, 0) = objFolder.getdetailsof(objFolder.items, varColumns(i))
Next i

fileCount = 0
For i = 0 To objFolder.items.Count - 1
strFilename = objFolder.getdetailsof(objFolder.items.Item(CLng(i)), 0)
If Right(strFilename, 4) = ".jpg" Or Right(strFilename, 4) = ".JPG" Or Right(strFilename, 4) = ".CR2" Or Right(strFilename, 4) = ".cr2" Or Right(strFilename, 4) = ".nef" Or Right(strFilename, 4) = ".NEF" Then
fileCount = fileCount + 1
For j = 0 To UBound(varColumns)
arrData(j, fileCount) = objFolder.getdetailsof(objFolder.items.Item(CLng(i)), varColumns(j))
Next j
End If
Next i

On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(objFolder.Title).Delete
Application.DisplayAlerts = True
On Error GoTo 0

Set wksResults = ThisWorkbook.Worksheets.Add
wksResults.Name = objFolder.Title

With wksResults
.Range("A1").Resize(UBound(arrData, 2) + 1, UBound(arrData, 1) + 1).Value = Application.Transpose(arrData)
.Columns.AutoFit

Set objShellApp = Nothing
Set objFolder = Nothing
Set wksResults = Nothing

End With

End Sub





This is code that I found on another website, but I don't know how to incorporate it into the code I'm using above:
--------------------------------------------------------------------------------------------------------------------------------


<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">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</code>

 

[Rijnsent]

Hi csenor,
check out this (quite recent) post, which worked for the poster: https://www.mrexcel.com/forum/excel...a-get-name-date-gps-data-pictures-folder.html
Cheers,
Koen

 

[csenor]

Thank you. I'll check it out.

 

[csenor]

Hi Koen. Is there anyway to modify my code above to add the latitude and longitude to the end of the columns already being generated? The piece of code varColumns = Array(0, 1, 2, 12, 30) lists name, size, item type, date taken, and camera model. I have to make a photo log for work. I'm not very savvy in VBA. It's a skill I want to learn more about, but I'm not sure why some file properties can be listed by this array and others can't.

 

[Rijnsent]

Hi Csenor,
it's probably easier to modify the code in that other threat. Did you check out the bit:

For Each P In ImgFile.Properties
Debug.Print P.Name
Next P

On Error Resume Next ' some of the pictures do not have this data
Worksheets("Src").Cells(Rw, 3).Value = ImgFile.Properties("DateTime")
On Error GoTo 0

The first one basically lists all file properties by name, like "DateTime". But there should be one for file type, date taken and camera model too. So run that For Each P loop and see what the Debug.print (direct) window shows. That should give you the names for the properties you're looking for.
For how the debug.print works, check out: http://learnexcelmacro.com/wp/2018/03/what-is-immediate-window-and-how-to-use-it-in-excel-vba/ To start with VBA, try e.g. https://www.homeandlearn.org/ or https://www.excel-pratique.com/en/vba/
Kind regards,
Koen

 

[famschechter]

tried this code and keep getting object required. it has this error when it calls getexifreader. i do a debug.print before this call for the file.path and it prints the directory with the file name and JPG extension. Please help?

Ron

 

[Rijnsent]

Welcome to the forum, Ron. So what code are you using? Does it include the function called getexifreader ? If not, that might be your issue. Another solution: try the image functions I made in this project: GitHub - krijnsent/geo_vba: A geographic toolkit/library for VBA, excel etc.
Cheers