title: Excel VBA open folder and get GPS info (Exif) of each files in it
body: <p>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.</p>
  
  <p>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.</p>
  
  <p><a href="http://www.everythingaccess.com/downloads/GPSExifReader.zip" rel="nofollow">EXIFReader</a></p>
  
  <p>Sarah</p>
  
  <p>EDIT Thanks to David, here's my modified version:</p>
  
  <pre><code>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" &amp; currrow).Value = "GPSLatitudeDecimal:        " &amp; .GPSLatitudeDecimal
                  Sheet1.Range("B" &amp; currrow).Value = "GPSLongitudeDecimal:       " &amp; .GPSLongitudeDecimal
                  Sheet1.Range("C" &amp; currrow).Value = "GPSAltitudeDecimal:        " &amp; .GPSAltitudeDecimal
             End With
         End Select
  NextFile:
      Next
      Exit Sub
  
  ExifError:
      MsgBox "An error has occurred with file: " &amp; file.Name &amp; vbCrLf &amp; vbCrLf &amp; Err.Description
      Err.Clear
      Resume NextFile
  End Sub
  </code></pre>