Geocoding in VBA
05.12.2013 11:32:18
Georg
ich versuche mit nachfolgender Funktion einen String an Virtualearth zu senden (das Googlemaps von BING) und eine vollständige Addresse zurück zu erhalten.
Leider kann ich die zurückerhaltene XML nicht auslesen. Ziel wäre vor allem der Bereich "FromattedAddress". Ich lande immer im Bereich "XMLKnoten is nothing"
Kann mir hier BITTE jemand helfen.
Function getBingGeocode(sAddr As String) As String
Dim xhrRequest As XMLHTTP60
Dim domResponse As DOMDocument60
Dim ixnStatus As IXMLDOMNode
Dim ixnMessage As IXMLDOMNode
Dim ixnFAdr As IXMLDOMNode
Dim sQuery As String
Dim xmlKnoten As IXMLDOMNode
Dim X As IXMLDOMNode
Dim nsString As String
Dim xpathKnoten As String
Set xhrRequest = New XMLHTTP60
sQuery = "http://dev.virtualearth.net/REST/v1/Locations?" & _
"key=AjDAVwKaeYct-vJOT8sJ0NJeZXln3Krmwc1HOG_3QF-nYcVH8wHmaGnRVOPwVzaa&" & _
"o=xml&" & _
"c=de&" & _
"q=" & Replace(sAddr, " ", "+")
xhrRequest.Open "GET", sQuery, False
xhrRequest.send
Set domResponse = New DOMDocument60
domResponse.LoadXML xhrRequest.responseText
domResponse.async = False
domResponse.validateOnParse = True
Set xmlKnoten = domResponse.SelectSingleNode("/*")
nsString = ""
For Each X In xmlKnoten.Attributes
If Left(X.XML, 5) = "xmlns" Then
nsString = nsString & " " & Replace(X.XML, """", "'")
End If
Next
domResponse.setProperty "SelectionNamespaces", nsString
MsgBox nsString
xpathKnoten = "/StatusCode" ' Knoten-Pfad für die XPath-Anweisung
Set xmlKnoten = domResponse.SelectSingleNode(xpathKnoten) ' XPath-Anweisung
If xmlKnoten Is Nothing Then
MsgBox xpathKnoten & "-Knoten nicht gefunden. Vermutlich falsche XML-Struktur oder kein _
Namespace angegeben", _
vbCritical
Exit Function
End If
Set ixnStatus = domResponse.SelectSingleNode("/Response/StatusCode")
Set ixnMessage = domResponse.SelectSingleNode("//StatusDescription")
Set ixnFAdr = domResponse.SelectSingleNode("//FormattedAddress")
If ixnStatus.Text "OK" Then
MsgBox ixnMessage.Text
MsgBox ixnFAdr.Text
End
End If
getBingGeocode = ixnFAdr.Text
End Function