• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

GPS gegevens uit foto halen

AatB

Gebruiker
Lid geworden
15 dec 2007
Berichten
258
Hallo, ik wil foto's afdrukken met op de achterkant een landkaartje waar deze foto genomen en wanneer.
Als ik bij eigenschappen van de foto kijk, zie ik de GPS gegevens staan (Lengtegraad, Breedtegraad en Hoogte).

Middels een macro wil de foto kiezen en de foto + gps gegevens in een excelsheet zetten.
Daarna kan ik dan via Google maps het kaartje ophalen mbv de gps gegevens.

Met deze code haal ik alle gegevens op, maar de GPS gegevens staan er niet bij.

Code:
Sub CheckAlleEigenschappen()
    Dim shellApp As Object, folderObj As Object, fileObj As Object
    Dim filePath As String, fileName As String, folderPath As String
    Dim i As Integer
    
    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show = -1 Then filePath = .SelectedItems(1) Else Exit Sub
    End With
    
    folderPath = Left(filePath, InStrRev(filePath, "\") - 1)
    fileName = Mid(filePath, InStrRev(filePath, "\") + 1)
    Set shellApp = CreateObject("Shell.Application")
    Set folderObj = shellApp.Namespace(CVar(folderPath))
    Set fileObj = folderObj.ParseName(fileName)
    
    
    ActiveSheet.Cells.ClearContents
    For i = 0 To 370
        Cells(i + 1, 1).Value = i
        Cells(i + 1, 2).Value = folderObj.GetDetailsof(Null, i) ' De naam van het veld
        Cells(i + 1, 3).Value = folderObj.GetDetailsof(fileObj, i) ' De waarde
    Next i
    Columns("A:C").AutoFit
End Sub

Weet iemand een oplossing?

Bedankt alvast.

mvg,

Aat
 
Wat de vorige post met Excel en VBA te maken heeft, zie ik even niet. Exit informatie kun je met veel,programma's zien, zoals FastViewer. Heb je deze macro al bekeken?

Code:
Sub GetFileInfo2()
    strFolder = "C:Pictures\desktopbackground\"

    strFile = "20170312_101b.jpg"
    'Reference to Microsoft Windows Image Acquisition Library 2.0
    Set ImgFile = New WIA.ImageFile
    ImgFile.LoadFile (strFolder & strFile)
    Rw = 3
    For Each P In ImgFile.Properties
        Debug.Print P.Name
    Next P
    Worksheets("Src").Cells(Rw, 2).Value = strFolder
    Worksheets("Src").Cells(Rw, 3).Value = strFile
    Worksheets("Src").Cells(Rw, 4).Value = ImgFile.Properties("DateTime")
    If UCase(Right(strFile, 3)) = "JPG" Then
        'Images only
        On Error Resume Next
        iLat = ImgFile.Properties("GpsLatitude")
        iLatRef = ImgFile.Properties("GpsLatitudeRef")
        iLng = ImgFile.Properties("GpsLongitude")
        iLngRef = ImgFile.Properties("GpsLongitudeRef")
        On Error GoTo 0
        If Not IsEmpty(iLat) Then
            LatDec = iLat(1) + iLat(2) / 60 + iLat(3) / 3600
            If iLatRef = "S" Then LatDec = LatDec * -1
        Else
            LatDec = 0
        End If
        If Not IsEmpty(iLng) Then
            LngDec = iLng(1) + iLng(2) / 60 + iLng(3) / 3600
            If iLngRef = "W" Then LngDec = LngDec * -1
        Else
            LngDec = 0
        End If
        Worksheets("Src").Cells(Rw, 5).Value = ImgFile.Width
        Worksheets("Src").Cells(Rw, 6).Value = ImgFile.Height
        Worksheets("Src").Cells(Rw, 7).Value = LatDec
        Worksheets("Src").Cells(Rw, 8).Value = LngDec
    End If

End Sub
 
Octa, zit een foutje in je strFolder pad. ;)
 
Terug
Bovenaan Onderaan