Excel2007 VBA Geocoding von Adressen

Ich ertselle ein Excel Sheet für die Verwaltung von Wanderparkplätzen.

Jetzt habe ich ein Userform erstellt wo ich die Daten einfacher in die Tabellen einpflegen kann.

In das Userform möchte ich die möglich einbauen, eine Adresse einzugeben, danach auf einen Button zu klicken
und die entsprechenden Koordinaten Lat und Lon  für die Adresse suchen zu lassen.

 

Wie erstelle ich in VBA eine Verbindung zur GooglMaps API für Geocoding

Wie frage ich die Daten mit VBA ab und füge diese in das Userform ein.

 

mfg Matthias

Annehmen
Annehmen

Ich habe das nun so gelöst.

Was mir aber jetzt noch aufgefallen ist das es sein kann das er mehrere Daten Orte zu einem Ort findet.  Steinach gibt es z.B. mehrfach in Deutschland.

Hier ist jetzt noch die Frage wie ich das dann  bei bedarf in eine Listenbox reinschreibe also nur den Ort die PLZ und den Landkreis. Bei doppelklick in der listbox sollen dann die daten in das Userform schreiben. 

 

Private Sub CommandButton5_Click()

    ' Adressen Geocoding mit Google Maps
    Dim sAdrStrasse As String
    Dim sURL As String
    Dim sAdress As String
    Dim strState As String
       
    ' xml parsing
    Dim xhrRequest As XMLHTTP60
    Dim sQuery As String
    Dim domResponse As DOMDocument60
    Dim ixnStatus As IXMLDOMNode
    Dim ixnLat As IXMLDOMNode
    Dim ixnLng As IXMLDOMNode
    Dim ixnGEMEINDE As IXMLDOMNode
    Dim ixnLK As IXMLDOMNode
    Dim ixnORT As IXMLDOMNode
    Dim ixnPLZ As IXMLDOMNode
      
    Dim getGoogleMapsGeocode As String
    Dim getGoogleMapsLK As String
    Dim getGoogleMapsGemeinde As String
    Dim getGoogleMapsPLZ As String
    Dim getGoogleMapsORT As String
                      
                                            
    sAdrStrasse = ""
   
    'Textbox Straße prüfen
    If SUCHE_STRASSE.text = "" Then
        sAdrStrasse = ""
    Else
        sAdrStrasse = SUCHE_STRASSE.text
    End If
               
       
    ' Land festlegen
    strState = "Deutschland"

    ' Adresse  zusammensetzten
    sAdress = " " & Replace(sAdrStrasse, " ", "+") & " " & strState & " "

    'http://maps.google.com/maps/api/geocode/xml?address=1600+Amphitheatre+Parkway,+Mountain+View,+CA&sensor=true_or_false
   
    ' Felder leeren
    getGoogleMapsGeocode = ""
    getGoogleMapsLK = ""
    getGoogleMapsGemeinden = ""
    getGoogleMapsPLZ = ""
    getGoogleMapsORT = ""
 
    Set xhrRequest = New XMLHTTP60
    sQuery = "http://maps.googleapis.com/maps/api/geocode/xml?sensor=false&address="
    sQuery = sQuery & sAdress & strState
    xhrRequest.Open "GET", sQuery, False
    xhrRequest.send
 
    Set domResponse = New DOMDocument60
    domResponse.LoadXML xhrRequest.responseText
    Set ixnStatus = domResponse.SelectSingleNode("//status")
 
    If (ixnStatus.text <> "OK") Then
    Exit Sub
    End If
 
    ''''''''''''''''''''''''''''''''''''''''''''''''
    ' Breitengrad suchen
    ''''''''''''''''''''''''''''''''''''''''''''''''
   
    'Wenn XML Tag <lat> vorahanden
    If domResponse.SelectSingleNode("/GeocodeResponse/result/geometry/location/lat") Is Nothing = False Then
        '... dann Wert aus <lat> in Variable schreiben ...
        Set ixnLat = domResponse.SelectSingleNode("/GeocodeResponse/result/geometry/location/lat")
         
        slat = ixnLat.text
        TextBox10.Value = Replace(slat, ".", ",")
       
    Else
        '... wenn XML Tag <lat> nicht vorhanden
        Set ixnLat = Nothing
        TextBox11.Value = ""
    End If

    ''''''''''''''''''''''''''''''''''''''''''''''''
    ' Längengrad suchen
    ''''''''''''''''''''''''''''''''''''''''''''''''

    'Wenn XML Tag <lng> vorhanden
    If domResponse.SelectSingleNode("/GeocodeResponse/result/geometry/location/lng") Is Nothing = False Then
        '... dann Wert aus <lat> in Variable schreiben ...
        Set ixnLng = domResponse.SelectSingleNode("/GeocodeResponse/result/geometry/location/lng")
       
        slng = ixnLng.text
        TextBox11.Value = Replace(slng, ".", ",")
       
    Else
        '... wenn XML Tag nicht vorhanden
        Set ixnLng = Nothing
        TextBox11.Value = ""
    End If
   
    ''''''''''''''''''''''''''''''''''''''''''''''''
    ' Ortsdaten suchen
    ''''''''''''''''''''''''''''''''''''''''''''''''

    'Wenn XML Tag <address_component - type = locality> vorhanden
    If domResponse.SelectSingleNode("/GeocodeResponse/result/address_component[type = 'locality']/long_name") Is Nothing = False Then
        '... dann Wert aus <lat> in Variable schreiben ...
       Set ixnGEMEINDE = domResponse.SelectSingleNode("/GeocodeResponse/result/address_component[type = 'locality']/long_name")
        TextBox1.Value = ixnGEMEINDE.text
    Else
        '... wenn XML Tag nicht vorhanden
        Set ixnGEMEINDE = Nothing
        TextBox1.Value = ""
    End If
   
    ' Administrative Daten für Ort
    'Wenn XML Tag <address_component - type = sublocality> vorhanden
    If domResponse.SelectSingleNode("/GeocodeResponse/result/address_component[type = 'sublocality']/long_name") Is Nothing = False Then
        '... dann Wert aus <lat> in Variable schreiben ...
        Set ixnORT = domResponse.SelectSingleNode("/GeocodeResponse/result/address_component[type = 'sublocality']/long_name")
        TextBox2.Value = ixnORT.text
    Else
        '... wenn XML Tag nicht vorhanden
        Set ixnORT = Nothing
        TextBox2.Value = ""
    End If
   
    ''''''''''''''''''''''''''''''''''''''''''''''''
    ' Eingaben und Verbindung zurücksetzen
    ''''''''''''''''''''''''''''''''''''''''''''''''
   
    SUCHE_STRASSE.Value = ""
   
    'Clean up66.
    Set xhrRequest = Nothing
   
    ''''''''''''''''''''''''''''''''''''''''''''''''
    ' GoogleMaps Geocoding XML Ausgabe in Website anzeigen
    ''''''''''''''''''''''''''''''''''''''''''''''''
  
    ' Daten Ausgeben
    'Set objIE = CreateObject("InternetExplorer.Application")
    'objIE.Navigate sQuery
    'objIE.Visible = True
     
End Sub

leben und leben lassen

War diese Antwort hilfreich?

Das war leider nicht hilfreich.

Toll! Vielen Dank für Ihr Feedback.

Wie zufrieden sind Sie mit dieser Antwort?

Vielen Dank für Ihr Feedback. Das hilft uns, die Website zu verbessern.

Wie zufrieden sind Sie mit dieser Antwort?

Vielen Dank für Ihr Feedback.

 
 

Frageninformationen


Zuletzt aktualisiert 25 September, 2023 Aufrufe 1.623 Gilt für: