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

JustynHart

New Member
Joined
Oct 30, 2017
Messages
3
i came across this code of another webpage and i keep getting an error saying object required, i have followed all the instructions for this "expert" but it will not work, any help??



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.
<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; white-space: inherit;">Function OpenFile(ByVal FilePath As String) As GPSExifProperties
Set OpenFile = m_ClassFactory.OpenFile(FilePath)
End Function</code>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.
<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; 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>You need to modify this:
<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; white-space: inherit;">Set fldr = fso.GetFolder("C:/users/david_zemens/desktop/") </code>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 :)
<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; white-space: inherit;">Debug.Print strDump </code>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
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

Forum statistics

Threads
1,223,888
Messages
6,175,219
Members
452,620
Latest member
dsubash

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top