AW: VBA-WIA Beispielcode
29.06.2020 15:04:05
Fennek
Hallo,
Volti hat Recht, die GPS-Daten sind binär.
Vor einiger Zeit habe ich einen VBA-Code erstellt, schau mal, ob du damit zurecht kommst:
'############## GPS #################
Function GPS_Loc(Fl As String) As String ' Übergabe eines Pfad & Dateinamens
Dim Img ' as Imagefile
Dim GPS(4) As String
Set Img = CreateObject("WIA.ImageFile")
Call Img.LoadFile(Fl)
If Img.Properties.Exists("1") Then GPS(0) = Img.Properties("1").Value 'N
If GPS(0) = "" Then GPS_Loc = "nv": Exit Function
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: Exit Function
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
ERASE GPS
'einzelne Fotos, alle Propeties
'andere Methoden: p.value.Numerator, p.value.Denumerator
'if p.type = RationalImagePropertyType Then s = s & p.Value.Numerator & "/" & p.Value. _
Denominator
'if p.Type = StringImagePropertyType then
'if p.SubType UnspecifiedSubType then
'if p.Value p.SubTypeDefault then
'if p.IsReadOnly then
'select Case p.SubType
' Case FlagSubType
' For i = 1 To p.SubTypeValue.Count
' s = s & p.SubTypeValues(i)
' If i p.SubTypeValues.Count Then s = s & ", "
' Next i
' Case ListSubType
' s = s & " [ valid values include:"
' For i = 1 To p.SubTypeValues.Count
' s = s & p.SubTypeValues(i)
' If i p.SubTypeValues.Count Then
' s = s & ", "
' End If
' Next
' s = s & " ]"
' Case RangeSubType
' s = s & " [ valid values in the range from " & _
' p.SubTypeMin & " to " & p.SubTypeMax & _
" in increments of " & p.SubTypeStep & " ]"
' Case Else 'UnspecifiedSubType
' End Select
' If Img.Properties.Exists("40095") then
' Set v = Img.Properties("40095").Value
' s = s & "Subject = " & v.String & vbCrLf
' End If
'For Each p In Img.Properties
' Debug.Print p.propertyid, p.Name, p.Value, p.isvector
'Next p
'Alternative
'For i = 1 To objImage.Properties.Count
' Debug.Print i, Img.Properties(i).Name, Img.Properties(i).Value
'Next i
'Set v = CreateObject("WIA.Vector")
'v.Add 1
'v.Add 42
'v.Remove 1
'v.add "Text"
'MsgBox v(1)
Set Img = Nothing
End Function
Für wenige Fotos ist der Code ok, für viele dauert er zu lange, da jedesmal "WIA" erneut angelegt wird. Wenn man WIA einmal anlegt und dann eine Schleife über alle Fotos legt, wird es viiiiiiel schneller.
mfg