Fetching Geo-Coordinates from Mapquest-API using Excel-VBA

Background

For some little visualization project I had the idea of putting markers of each of our institute's partners on a world map. All I had was a list with names of about 1500 research institutes, addresses were not in the list.
So my plan was to find a suitable web service which I could query from MS Excel via Visual Basic for Applications (VBA) and programmatically fetch data from this service.

Implementation

After some web-research I finally stumbled over a video by DontFretBrett, where he explains how to fetch geo-data using VBA in Excel via the google maps API. For me the breakthrough was the usage of the XML-maps feature of Excel, where a web service can be called an can be databound to an Excel worksheet.
Furthermore I decided not to use the google maps API, but the openmaps "nominatim" web-service by openstreetmap.org which is free of charge and which can be used to search for non-well-formed geo-information, such as names of research institutes. I found out that openstreetmap restricts the number of calls per day so I finally switched to the free service of mapquest, which is based on nominatim.

Excel XML-Mapping

To do databinding of XML-data to an Excel worksheet, go to "developer tools" (mind that this tab needs to be activated in Excel-options) and there to the "XML-Source" button (please forgive my German Excel..):

When clicking on this button you'll get a new window to the right of your worksheet:

Therein click on the button "XML-Map" on the lower right of this window.

in the corresponding dialog enter the URL to the query you want to execute and give it some hany name (in my case "searchresults"). When you execute the search query, you will get something like this:

After achieving this, drag & drop the fields from the search results to a new worksheet. In my case this were the fields "lat", "lon" and "display_name" (address). Now you can update data in the XML-map window by executing the web-service and copy it to you driving worksheet with the information you have.

VBA Code

I implemented three routines:
1) One driver routine looping over the master worksheet
2) One routine calling the mapquest web service
3) One helper function which does a bit of data cleansing to get rid of special characters

Driver Routine

Sub GetAddressForInstitute()

Dim theSearchString As String
Dim selectedRow As Integer
Dim selectedColument As Integer

Worksheets("Collaborations").Activate

For Each theCell In Worksheets("Collaborations").Range("A5:A2000")
    theCell.Select
    selectedRow = Selection.Row
    selectedColumn = Selection.Column
    theSearchString = Replace(theCell.Text, " ", "+") + "+" + Cells(selectedRow, selectedColumn + 1).Text
    If (theSearchString <> "") Then
        theSearchString = cleanStringFromSpecialCharacters(theSearchString)
        If (theSearchString <> "") Then
            GetDataUpdateSheet (theSearchString)
        End If
    
        Cells(selectedRow, 10).Select
        Selection.Value = Worksheets("lat_lon").Cells(2, 1).Value 'Latitude
        Cells(selectedRow, 11).Select
        Selection.Value = Worksheets("lat_lon").Cells(2, 2).Value 'Longitude
        Cells(selectedRow, 12).Select
        Selection.Value = Worksheets("lat_lon").Cells(2, 3).Value 'Address
    End If
Next theCell
End Sub

Service Caller

Sub GetDataUpdateSheet(searchString As String)
    Dim theMap As XmlMap
   
    Set theMap = ActiveWorkbook.XmlMaps("searchresults")
    On Error Resume Next 'Special characters cause program to dump --> simply go over errors
    theMap.DataBinding.LoadSettings ("http://open.mapquestapi.com/nominatim/v1/search.php?q=" + searchString + "&format=xml")
    theMap.DataBinding.Refresh
End Sub

Special Character Cleaner

Function cleanStringFromSpecialCharacters(inString As String) As String
    Dim outString As String
    outString = Replace(inString, "ä", "ae")
    outString = Replace(outString, "ã", "a")
    outString = Replace(outString, "à", "a")
    outString = Replace(outString, "á", "a")
    outString = Replace(outString, "â", "a")
    outString = Replace(outString, "Ä", "Ae")
    outString = Replace(outString, "ç", "c")
    outString = Replace(outString, "í", "i")
    outString = Replace(outString, "ö", "oe")
    outString = Replace(outString, "ü", "ue")
    outString = Replace(outString, "Ö", "Oe")
    outString = Replace(outString, "Ü", "ue")
    outString = Replace(outString, "ß", "ss")
    outString = Replace(outString, "ó", "o")
    outString = Replace(outString, "é", "e")
    outString = Replace(outString, "è", "e")
    outString = Replace(outString, "É", "E")
    outString = Replace(outString, " ", "+")
    outString = Replace(outString, ",", "")
    outString = Replace(outString, "+-", "")
        
    cleanStringFromSpecialCharacters = outString
End Function

I hope, dear reader, this article was helpful for your own project. All the best

WolfiG