Hallo Forum , bin zum ersten mal hier.
Habe den code eingebaut und bin völlig begeistert.
Jetzt fehlt mir zu meinem Glück nur noch das Auslesen von
<[u]AddressDetails Accuracy="4" xmlns="urnasis:names:tc:ciq:xsdschema:xAL:2.0">
Habe schon so einiges versucht, fluppt aber nicht.
Option Compare Database
Public Function getCoordinatesXML_AndMore(ByVal strOrtPLZ As String, _
ByVal strStrasse As String, _
ByRef strCoordinates As String, _
ByRef strCountryNameCode As String, _
ByRef strCountryName As String, _
ByRef strAdministrativeAreaName As String, _
ByRef strSubAdministrativeAreaName As String, _
ByRef strLocalityName As String, _
ByRef strDependentLocalityName As String, _
ByRef strThoroughfareName As String, _
ByRef strPostalCodeNumber As String, _
ByRef strAccuracy As String, _
Optional strLand As String = "Deutschland")
Dim IEApp As Object
Dim IEDocument As Object
Dim strArr As Variant
Dim i As Long
' IE-Instanz erstellen
Set IEApp = CreateObject("InternetExplorer.Application")
With IEApp
' IE-Fenster unsichtbar lassen
.Visible = True
' URL aufrufen
' Google-Maps im XML Format
.Navigate "http://maps.google.com/maps/geo?q=" & strOrtPLZ & "%20" & _
strStrasse & "%20" & strLand & "&output=xml&sensor=false&key=abcdefg"
' Warten, bis Seite geladen
Do: Loop Until .Busy = False
Do: Loop Until .Busy = False
While IEApp.Busy: Wend
' IE-Dokument
Set IEDocument = .Document
End With
Do
DoEvents
Loop Until IEDocument.readyState <> 4
' Inhalt des Webseiten-Dokuments auslesen und in Zeilen aufplitten
strArr = Split(IEDocument.Body.innerText, vbCrLf)
For i = LBound(strArr) To UBound(strArr)
' Accuracy
[u] ExtractData strArr(i), "Accuracy", strAccuracy
' Landcode
ExtractData strArr(i), "CountryNameCode", strCountryName
' Land
ExtractData strArr(i), "CountryName", strCountryName
' Bundesland
ExtractData strArr(i), "AdministrativeAreaName", strAdministrativeAreaName
' Bundesland Sub
ExtractData strArr(i), "SubAdministrativeAreaName", _
strSubAdministrativeAreaName
' Ort
ExtractData strArr(i), "LocalityName", strLocalityName
' Ortsteil
ExtractData strArr(i), "DependentLocalityName", strDependentLocalityName
' Strasse
ExtractData strArr(i), "ThoroughfareName", strThoroughfareName
' PLZ
ExtractData strArr(i), "PostalCodeNumber", strPostalCodeNumber
' Koordinaten
ExtractData strArr(i), "coordinates", strCoordinates
Next i
'IEApp.Quit
' Objekte zerstören
Set IEDocument = Nothing
Set IEApp = Nothing
End Function
Private Sub ExtractData(ByVal sData As String, ByVal sTag As String, ByRef _
sResult As String)
If InStr(1, sData, "</" & sTag & ">", vbTextCompare) > 0 Then
sResult = Trim$(Replace(sData, "</" & sTag & ">", ""))
sResult = Trim$(Replace(sResult, "<" & sTag & ">", ""))
End If
End Sub Könnte es an dem Trim liegen ?
Wäre prima, wenn mir jemend einen Schubs geben könnte
Gruß
Rudolf |