GPS-Daten aus Dateiinformationen auslesen

[Klaus-Dieter]

Hallo zusammen,

zur Abwechslung mal eine Frage von mir. Gibt es eine Möglichkeit, GPS-Daten, die eine Digitalkamera erfasst hat, aus den Dateiinformationen der Fotos auszulesen? Wenn ja, welche. Ich habe ein Excel-Makro, das diverse Informationen ausliest, nur eben die GPS-Daten nicht.

[Fennek]

Hallo Klaus-Dieter,

mit WIA (Windows Image Acquisition) geht das recht gut. Ich hoffe, dass ich hier die richtige Version gefunden habe:

Code:

Sub GPS_Read()
'Function GPS_Loc(Fl As String) As String   ' Übergabe eines Pfad & Dateinamens

   Dim Img ' as Imagefile
   Dim GPS(4) As String
   Dim App As Application: Set App = Application
   
   Set Img = CreateObject("WIA.ImageFile")
   
'Ordner auswählen
   With App.FileDialog(msoFileDialogFolderPicker)
       .InitialFileName = "c:\temp"
       If .Show Then Pt = .SelectedItems(1) & "\"
   End With
   
   Fl = Dir(Pt & "*.jpg")
   
Do While Len(Fl)

   Call Img.LoadFile(Pt & Fl)
   
   
   If Img.Properties.Exists("1") Then GPS(0) = Img.Properties("1").Value    'N
       If GPS(0) = "" Then GPS_Loc = "nv": GoTo NN
   If Img.Properties.Exists("2") Then
       For i = 1 To Img.Properties("2").Value.Count
           If Err.Number <> 0 Then GPS_Loc = "error": Err.Clear: GoTo NN
           GPS(1) = GPS(1) & Img.Properties("2").Value.Item(i) & Choose(i, "° ", "' ", "")
       Next i
   End If
   
   If Img.Properties.Exists("3") Then GPS(2) = Img.Properties("3").Value 'W/E
   
   If Img.Properties.Exists("4") Then
       For i = 1 To Img.Properties("4").Value.Count
           GPS(3) = GPS(3) & Img.Properties("4").Value.Item(i) & Choose(i, "° ", "' ", "")
       Next i
   End If
   
   If Img.Properties.Exists("6") Then GPS(4) = Img.Properties("6").Value

   If Len(GPS(1)) > 5 Then
       GPS_Loc = GPS(0) & GPS(1) & ", " & GPS(2) & GPS(3) & ", Höhe: " & Format(GPS(4), "0.00 m")
   Else
       GPS_Loc = "nv"
   End If
   lr = lr + 1
   Cells(lr, 1) = Fl
   Cells(lr, 2).Resize(, 4) = Application.Transpose(Application.Transpose(GPS))
   Erase GPS
NN:
Fl = Dir
Loop
   Set Img = Nothing
   
End Sub

mfg

[Klaus-Dieter]

Hallo Fennek,

vielen Dank dafür, funktioniert einwandfrei.

[Fennek]

Hallo Klaus-Dieter,

schön, dass es geholfen hat.

mfg

(bist Du neugierig, was der Hersteller so alles in den "MakerNotes" versteckt? WIA kann das gut auslesen, aber die Kodierung / Verschlüsselung zu dekodieren, war zu kompliziert für mich.)