xmlvbaapiopenstreetmapnominatim

I can't read the results of the openstreetmap api with vba


I have a database of addresses in MSAccess. I would like to fill in the gps coordinates (latitude and longitude) automatically. I found a VBA script that retrieves data from google, but I would like to rewrite this script to retrieve data from openstreetmap. the script I am modifying :

Public Function GetCoordinates(address As String) As String

    'Written By:    Christos Samaras
    'Date:          12/06/2014
    'Last Updated:  16/02/2020
    'E-mail:        xristos.samaras@gmail.com
    'Site:          https://www.myengineeringworld.net
    '-----------------------------------------------------------------------------------------------------
    
    'Declaring the necessary variables.
    Dim apiKey              As String
    Dim xmlhttpRequest      As Object
    Dim xmlDoc              As Object
    Dim xmlStatusNode       As Object
    Dim xmlLatitudeNode     As Object
    Dim xmLongitudeNode     As Object
    
    'Set your API key in this variable. Check this link for more info:
    'https://www.myengineeringworld.net/2018/02/how-to-get-free-google-api-key.html
    'Here is the ONLY place in the code where you have to put your API key.
    apiKey = "XXXXXXXXXXXXXXXXXXXXXXXXXX"
    
    'Check that an API key has been provided.
    If apiKey = vbNullString Or apiKey = "The API Key" Then
        GetCoordinates = "Empty or invalid API Key"
        Exit Function
    End If
    
    'Generic error handling.
    On Error GoTo errorHandler
    
    'Create the request object and check if it was created successfully.
    Set xmlhttpRequest = CreateObject("MSXML2.ServerXMLHTTP")
    
    If xmlhttpRequest Is Nothing Then
        GetCoordinates = "Cannot create the request object"
        Exit Function
    End If
    
    'Create the request based on Google Geocoding API. Parameters (from Google page):
    '- Address: The address that you want to geocode.
    'Note: The EncodeURL function was added to allow users from Greece, Poland, Germany, France and other countries
    'geocode address from their home countries without a problem. The particular function (EncodeURL),
    'returns a URL-encoded string without the special characters.
    'This function, however, was introduced in Excel 2013, so it will NOT work in older Excel versions.
    'xmlhttpRequest.Open "GET", "https://maps.googleapis.com/maps/api/geocode/xml?" _
    & "&address=" & address & "&key=" & apiKey, False

    xmlhttpRequest.Open "GET", "http://nominatim.openstreetmap.org/search?q=" & Replace(address, " ", "+") & "&format=xml&polygon=1&addressdetails=1"

    'An alternative way, without the EncodeURL function, will be this:
    'xmlhttpRequest.Open "GET", "https://maps.googleapis.com/maps/api/geocode/xml?" & "&address=" & Address & "&key=" & ApiKey, False
    
    'Send the request to the Google server.
    xmlhttpRequest.send
    
    'Create the DOM document object and check if it was created successfully.
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    
    If xmlDoc Is Nothing Then
        GetCoordinates = "Cannot create the DOM document object"
        Exit Function
    End If
    
    'Read the XML results from the request.
    xmlDoc.LoadXML xmlhttpRequest.responseText
    
    'Get the value from the status node.
    Set xmlStatusNode = xmlDoc.SelectSingleNode("//statusText")
    
    'Based on the status node result, proceed accordingly.
    Select Case UCase(xmlStatusNode.Text)
    
    Case "OK"                                    'The API request was successful.
        'At least one result was returned.
        'Get the latitude and longitude node values of the first result.
        Set xmlLatitudeNode = xmlDoc.SelectSingleNode("//result/geometry/location/lat")
        Set xmLongitudeNode = xmlDoc.SelectSingleNode("//result/geometry/location/lng")
        
        'Return the coordinates as a string (latitude, longitude).
        GetCoordinates = xmlLatitudeNode.Text & ", " & xmLongitudeNode.Text
    
    Case "ZERO_RESULTS"                          'The geocode was successful but returned no results.
        
        GetCoordinates = "The address probably do not exist"
    
    Case "OVER_DAILY_LIMIT"                      'Indicates any of the following:
        '- The API key is missing or invalid.
        '- Billing has not been enabled on your account.
        '- A self-imposed usage cap has been exceeded.
        '- The provided method of payment is no longer valid
        '  (for example, a credit card has expired).
        GetCoordinates = "Billing or payment problem"
    
    Case "OVER_QUERY_LIMIT"                      'The requestor has exceeded the quota limit.
        
        GetCoordinates = "Quota limit exceeded"
    
    Case "REQUEST_DENIED"                        'The API did not complete the request.
        
        GetCoordinates = "Server denied the request"
    
    Case "INVALID_REQUEST"                       'The API request is empty or is malformed.
        
        GetCoordinates = "Request was empty or malformed"
    
    Case "UNKNOWN_ERROR"                         'The request could not be processed due to a server error.
        
        GetCoordinates = "Unknown error"
    
    Case Else                                    'Just in case...
        
        GetCoordinates = "Error"
    
    End Select
    
    'Release the objects before exiting (or in case of error).
errorHandler:

    Set xmlStatusNode = Nothing
    Set xmlLatitudeNode = Nothing
    Set xmLongitudeNode = Nothing
    Set xmlDoc = Nothing
    Set xmlhttpRequest = Nothing
    
End Function

Everything goes fine until the response is read in xml in the line:

xmlDoc.LoadXML xmlhttpRequest.responseText

API OpenStreetMap (by Postman) returns:

<?xml version="1.0" encoding="UTF-8" ?>
<searchresults timestamp='Tue, 30 Nov 21 23:27:43 +0000' attribution='Data © OpenStreetMap contributors, ODbL 1.0. http://www.openstreetmap.org/copyright' querystring='Abramowice Kościelne Głusk' exclude_place_ids='282751943' more_url='https://nominatim.openstreetmap.org/search/?q=Abramowice+Ko%C5%9Bcielne+G%C5%82usk&amp;addressdetails=1&amp;exclude_place_ids=282751943&amp;format=xml'>
    <place place_id='282751943' osm_type='relation' osm_id='6187770' place_rank='16' address_rank='16' boundingbox="51.1900199,51.1955316,22.6211673,22.6355145" lat='51.1905395' lon='22.6282202' display_name='Abramowice Kościelne, gmina Głusk, powiat lubelski, województwo lubelskie, Polska' class='boundary' type='administrative' importance='0.59025964622406' icon='https://nominatim.openstreetmap.org/ui/mapicons//poi_boundary_administrative.p.20.png'>
        <village>Abramowice Kościelne</village>
        <municipality>gmina Głusk</municipality>
        <county>powiat lubelski</county>
        <state>województwo lubelskie</state>
        <country>Polska</country>
        <country_code>pl</country_code>
    </place>
</searchresults>

Beacuse the response api is different from google I am loading

xmlDoc.Load xmlhttpRequest.responseXML

But the problem is that I can't find <place></place> node in responseXml from xmlhttpRequest. In chaildNodes i can see only xml and searchresults. It looks like xmlDoc.Load and xmlhttpRequest did not load all xml levels node. How obtain <place></place> node in line xmlDoc.Load xmlhttpRequest.responseXML?

responseText returns that:

<?xml version="1.0" encoding="UTF-8" ?>
<searchresults timestamp='Wed, 01 Dec 21 06:38:10 +0000' attribution='Data © OpenStreetMap contributors, ODbL 1.0. http://www.openstreetmap.org/copyright' querystring='Abramowice KoĹ›cielne GĹ‚usk' more_url='https://nominatim.openstreetmap.org/search/?q=Abramowice+Ko%C4%B9%E2%80%BAcielne+G%C4%B9%E2%80%9Ausk&amp;addressdetails=1&amp;format=xml&amp;accept-language=pl%2Cen-GB%3Bq%3D0.7%2Cen%3Bq%3D0.3'>
</searchresults>

The problem was in the wrong query. I called the address "Abramowice Kościelne gm. Głusk" but api does not understand what it means gm. (commune in Polish) and therefore could not return eny result. When calling Abramowice Kościelne Głusk, I get the correct result in responseText.

<?xml version="1.0" encoding="UTF-8" ?>
<searchresults timestamp='Wed, 01 Dec 21 09:51:58 +0000' attribution='Data © OpenStreetMap contributors, ODbL 1.0. http://www.openstreetmap.org/copyright' querystring='Abramowice Kościelne Głusk' exclude_place_ids='282751943' more_url='https://nominatim.openstreetmap.org/search/?q=Abramowice+Ko%C5%9Bcielne+G%C5%82usk&amp;addressdetails=1&amp;exclude_place_ids=282751943&amp;format=xml&amp;accept-language=pl%2Cen-GB%3Bq%3D0.7%2Cen%3Bq%3D0.3'>
<place place_id='282751943' osm_type='relation' osm_id='6187770' place_rank='16' address_rank='16' boundingbox="51.1900199,51.1955316,22.6211673,22.6355145" lat='51.1905395' lon='22.6282202' display_name='Abramowice Kościelne, gmina Głusk, powiat lubelski, województwo lubelskie, Polska' class='boundary' type='administrative' importance='0.59025964622406' icon='https://nominatim.openstreetmap.org/ui/mapicons//poi_boundary_administrative.p.20.png'>
<village>Abramowice Kościelne</village><municipality>gmina Głusk</municipality><county>powiat lubelski</county><state>województwo lubelskie</state><country>Polska</country><country_code>pl</country_code></place></searchresults>

I think additional function URLEncode help to. Thx for fast help.


Solution

  • Most likely the address passed in address is not translated correctly with just Replace function so you should use Excel built-in function EncodeURL to translate it correctly.

    So change this line:

    xmlhttpRequest.Open "GET", "http://nominatim.openstreetmap.org/search?q=" & Replace(address, " ", "+") & "&format=xml&polygon=1&addressdetails=1"
    

    To this:

    xmlhttpRequest.Open "GET", "http://nominatim.openstreetmap.org/search?q=" & WorksheetFunction.EncodeURL(address) & "&format=xml&polygon=1&addressdetails=1"
    

    EncodeURL function is only available from Excel 2013 so if you are running this from Access - You will probably need to use a function to encode the URL (I'm not sure if Access have any built-in function that encode URL)

    I tried this with success (Source: How can I URL encode a string in Excel VBA?) so paste the function below to your module as well:

    Public Function URLEncode( _
       ByVal StringVal As String, _
       Optional SpaceAsPlus As Boolean = False _
    ) As String
      Dim bytes() As Byte, b As Byte, i As Integer, space As String
    
      If SpaceAsPlus Then space = "+" Else space = "%20"
    
      If Len(StringVal) > 0 Then
        With New ADODB.Stream
          .Mode = adModeReadWrite
          .Type = adTypeText
          .Charset = "UTF-8"
          .Open
          .WriteText StringVal
          .Position = 0
          .Type = adTypeBinary
          .Position = 3 ' skip BOM
          bytes = .Read
        End With
    
        ReDim result(UBound(bytes)) As String
    
        For i = UBound(bytes) To 0 Step -1
          b = bytes(i)
          Select Case b
            Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
              result(i) = Chr(b)
            Case 32
              result(i) = space
            Case 0 To 15
              result(i) = "%0" & Hex(b)
            Case Else
              result(i) = "%" & Hex(b)
          End Select
        Next i
    
        URLEncode = Join(result, "")
      End If
    End Function
    

    And change the line above to:

    xmlhttpRequest.Open "GET", "http://nominatim.openstreetmap.org/search?q=" & URLEncode(address) & "&format=xml&polygon=1&addressdetails=1"