
Geonames is a geographical database with web services that let you extract useful information about different places, such as weather, timezone and post codes. This information may be extracted programmatically for use in your VBA programs.
I've only included the highlights, for a full listing of services visit the Geonames API services list. Also, I haven't fully implemented each method. For example, some API calls might return 10 data points, but my functions only return two or three.
No API key is required, but as usual I recommend you limit the amount of querying you do. I didn't include any caching in most of these examples, however.
These VBA functions use the standard XML processing we've seen in other articles (Bing API, Periodic Table, NYS Legislature): call the web API, save the XML response, open and parse it using the MSXML object model.
Don't forget to include the helper functions in your VBA project.
Return ISO country code for a given country
Provide a latitude and longitude to this function and it returns the ISO country code for whatever country is found at those coordinates. One way to get latitude and longitude in VBA is to visit Latitude Longitude Functions.
The API returns
- country code
- country name
- distance from latitude and longitude
Function GetISOCountryCode(lat As String, lng As String, Optional radius As Long = 10) As String()
Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFile As String
Dim tempString() As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim geoNames As Object ' MSXML2.IXMLDOMNode
Dim country As Object ' MSXML2.IXMLDOMNode
Dim i As Long
tempFile = environ("temp") & "\geonamescountrycode.xml"
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
xml.Open "GET", "http://ws.geonames.org/countryCode?lat=" & _
lat & "&lng=" & lng & "&radius=" & radius & "&type=xml", False
xml.send
result = ConvertAccent(xml.responseText)
' create XML file from result
Call CreateFile(tempFile, result)
' create XML doc
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.async = False
.validateOnParse = False
.Load tempFile
End With
' check that the XML doc loaded
If LoadError(xmlDoc) Then
Exit Function
End If
' get first level nodes
Set geoNames = xmlDoc.childNodes(1)
Set country = geoNames.childNodes(0)
' resize array
ReDim tempString(1 To country.childNodes.Length)
For i = 1 To country.childNodes.Length
tempString(i) = country.childNodes(i - 1).nodeTypedValue
Next i
GetISOCountryCode = tempString
End Function
Sample usage
Sub TestGeoNames()
Dim tempString() As String
Dim i As Long
Dim lat As String, lng As String
lat = "47.03"
lng = "10.2"
tempString = GetISOCountryCode(lat, lng)
For i = LBound(tempString) To UBound(tempString)
Debug.Print tempString(i)
Next i
End Sub
Here's a sample response:
<?xml version="1.0" encoding="UTF-8" standalone="no" ?>
<geonames>
<country>
<countryCode>AT</countryCode>
<countryName>Austria</countryName>
<distance>0.0</distance>
</country>
</geonames>
Get Country Info
This function returns specific data points about the country code you pass in. It returns the following information:
- iso alpha2
- iso alpha3
- iso numeric
- fips code
- name
- capital
- areaInSqKm
- population
- continent
- languages
- currency
- geonameId
The language is assumed to be English. I'm not sure what other languages are available, check the documentation and experiment with different language codes. The Bing API may also provide some valid language codes.
Function GetCountryInfo(countryCode As String, Optional language As String = "en") As String()
Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFile As String
Dim tempString() As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim geoNames As Object ' MSXML2.IXMLDOMNode
Dim country As Object ' MSXML2.IXMLDOMNode
Dim i As Long
tempFile = environ("temp") & "\geonamescountryinfo.xml"
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
xml.Open "GET", "http://ws.geonames.org/countryInfo?lang=" & _
language & "&country=" & countryCode & "&type=xml", False
xml.send
result = ConvertAccent(xml.responseText)
' create XML file from result
Call CreateFile(tempFile, result)
' create XML doc
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.async = False
.validateOnParse = False
.Load tempFile
End With
' check that the XML doc loaded
If LoadError(xmlDoc) Then
Exit Function
End If
' get first level nodes
Set geoNames = xmlDoc.childNodes(1)
Set country = geoNames.childNodes(0)
' resize array
ReDim tempString(1 To country.childNodes.Length)
For i = 1 To country.childNodes.Length
tempString(i) = country.childNodes(i - 1).nodeTypedValue
Next i
GetCountryInfo = tempString
End Function
Sample usage
This sample procedure returns country information about the good 'ole USA.
Sub TestGeoNames()
Dim tempString() As String
Dim i As Long
Dim country As String
country = "USA"
tempString = GetCountryInfo(country)
For i = LBound(tempString) To UBound(tempString)
Debug.Print tempString(i)
Next i
End Sub
Extended place information
From Geonames:
Returns the most detailed information available for the lat/lng query as xml document
It is a combination of several services. Example:
In the US it returns the address information.
In other countries it returns the hierarchy service: http://ws.geonames.org/extendedFindNearby?lat=47.3&lng=9
On oceans it returns the ocean name.
For foreign countries this function returns
- toponym name
- name
- latitude
- longitude
- geoname ID
- country code
- country name
- fcl
- fcode
The first node returns information about Earth, the second about the continent, the third about the country, and so on.
Function ExtendedFind(lat As String, lng As String) As String()
Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFile As String
Dim tempString() As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim geoNames As Object ' MSXML2.IXMLDOMNode
Dim geoName As Object ' MSXML2.IXMLDOMNode
Dim i As Long, j As Long
tempFile = environ("temp") & "\geonamesextendedfind.xml"
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
xml.Open "GET", "http://ws.geonames.org/extendedFindNearby?lat=" & _
lat & "&lng=" & lng & "&type=xml", False
xml.send
result = ConvertAccent(xml.responseText)
' create XML file from result
Call CreateFile(tempFile, result)
' create XML doc
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.async = False
.validateOnParse = False
.Load tempFile
End With
' check that the XML doc loaded
If LoadError(xmlDoc) Then
Exit Function
End If
' get first level nodes
Set geoNames = xmlDoc.childNodes(1)
' resize array
' there are eight nodes per data point
ReDim tempString(1 To geoNames.childNodes.Length, 1 To 9)
For i = 1 To geoNames.childNodes.Length
Set geoName = geoNames.childNodes(i - 1)
For j = 1 To geoName.childNodes.Length
tempString(i, j) = geoName.childNodes(j - 1).nodeTypedValue
Next j
Next i
ExtendedFind = tempString
End Function
Sample usage
Sub TestGeoNames()
Dim tempString() As String
Dim i As Long, j As Long
Dim lat As String, lng As String
lat = "47.03"
lng = "10.2"
tempString = ExtendedFind(lat, lng)
For i = LBound(tempString) To UBound(tempString)
For j = LBound(tempString, 2) To UBound(tempString, 2)
Debug.Print tempString(i, j)
Next j
Next i
End Sub
Return Nearby Postal Codes
This function is useful for anyone trying to resolve post codes or lookup addresses in Excel. Provide a post code and country and it returns the five post codes within a ten mile radius, along with miscellaneous information about each post code. To find out the countries that support postal geocoding, run GetPostalCodeCountryInfo.
This function also returns the post code's latitude and longitude, so you can use this function for that purpose in addition to finding nearby post codes!
Function GetNearbyPostCodes(postCode As String, countryCode As String, Optional radius As Long = 10, Optional maxRows As Long = 5) As String()
Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFile As String
Dim tempString() As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim geoNames As Object ' MSXML2.IXMLDOMNode
Dim code As Object ' MSXML2.IXMLDOMNode
Dim i As Long, j As Long
tempFile = environ("temp") & "\geonamesnearbypostcodes.xml"
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
xml.Open "GET", "http://ws.geonames.org/findNearbyPostalCodes?postalcode=" & _
postCode & "&country=" & countryCode & "&radius=" & radius & _
"&maxRows=" & maxRows & "&type=xml", False
xml.send
result = ConvertAccent(xml.responseText)
' create XML file from result
Call CreateFile(tempFile, result)
' create XML doc
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.async = False
.validateOnParse = False
.Load tempFile
End With
' check that the XML doc loaded
If LoadError(xmlDoc) Then
Exit Function
End If
' get first level nodes
Set geoNames = xmlDoc.childNodes(1)
' resize array
' there are 12 nodes per data point
ReDim tempString(1 To geoNames.childNodes.Length, 1 To 12)
For i = 1 To geoNames.childNodes.Length
Set code = geoNames.childNodes(i - 1)
For j = 1 To code.childNodes.Length
tempString(i, j) = code.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetNearbyPostCodes = tempString
End Function
Sample usage
This sample procedure will return the five zip codes within a ten mile radius of my own zip code.
Sub TestGeoNames()
Dim tempString() As String
Dim i As Long, j As Long
Dim country As String
country = "USA"
tempString = GetNearbyPostCodes("11103", country)
For i = LBound(tempString) To UBound(tempString)
For j = LBound(tempString, 2) To UBound(tempString, 2)
Debug.Print tempString(i, j)
Next j
Next i
End Sub
Here is a sample result:
<geonames> <code> <postalcode>11103</postalcode> <name>Astoria</name> <countryCode>US</countryCode> <lat>40.762651</lat> <lng>-73.914886</lng> <adminCode1>NY</adminCode1> <adminName1>New York</adminName1> <adminCode2>081</adminCode2> <adminName2>Queens</adminName2> <adminCode3 /> <adminName3 /> <distance>0.0</distance> </code>
Return countries that support postal geocoding
This function returns a list of countries that can provide postal geocoding data. It returns the country code, the country name, the number of postal codes, the starting post code and the ending post code. Use the country code returned by this function as a parameter for the other functions.
The result of this query is cached because it is unlikely to change. To force a requery of the API, call the function with a parameter of True.
Function GetPostalCodeCountryInfo(Optional forceRefresh As Boolean = False) As String()
Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFile As String
Dim tempString() As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim geoNames As Object ' MSXML2.IXMLDOMNode
Dim country As Object ' MSXML2.IXMLDOMNode
Dim i As Long, j As Long
tempFile = environ("temp") & "\geonamespostcodecountries.xml"
If Len(Dir(tempFile)) = 0 Or forceRefresh Then
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
xml.Open "GET", "http://ws.geonames.org/postalCodeCountryInfo?type=xml", False
xml.send
result = ConvertAccent(xml.responseText)
' create XML file from result
Call CreateFile(tempFile, result)
End If
' create XML doc
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.async = False
.validateOnParse = False
.Load tempFile
End With
' check that the XML doc loaded
If LoadError(xmlDoc) Then
Exit Function
End If
' get first level nodes
Set geoNames = xmlDoc.childNodes(1)
' resize array
' there are 5 nodes per data point
ReDim tempString(1 To geoNames.childNodes.Length, 1 To 5)
For i = 1 To geoNames.childNodes.Length
Set country = geoNames.childNodes(i - 1)
For j = 1 To country.childNodes.Length
tempString(i, j) = country.childNodes(j - 1).nodeTypedValue
Next j
Next i
GetPostalCodeCountryInfo = tempString
End Function
Sample usage
This procedure will display all the return data in the Immediate window. You could also assign this result directly to a listbox.
Sub TestGeoNames()
Dim tempString() As String
Dim i As Long, j As Long
tempString = GetPostalCodeCountryInfo
For i = LBound(tempString) To UBound(tempString)
For j = LBound(tempString, 2) To UBound(tempString, 2)
Debug.Print tempString(i, j)
Next j
Next i
End Sub
Here's a sample response:
<?xml version="1.0" encoding="UTF-8" standalone="no" ?>
<geonames>
<country>
<countryCode>AD</countryCode>
<countryName>Andorra</countryName>
<numPostalCodes>7</numPostalCodes>
<minPostalCode>AD100</minPostalCode>
<maxPostalCode>AD700</maxPostalCode>
</country>
<country>
<countryCode>AR</countryCode>
<countryName>Argentina</countryName>
<numPostalCodes>20260</numPostalCodes>
<minPostalCode>1601</minPostalCode>
<maxPostalCode>9431</maxPostalCode>
</country>
Return time zone for a given point on Earth
This function returns the following information, given a latitude and longitude:
- country code
- country name
- latitude
- longitude
- timezone ID
- DST offset
- GMT offset
- raw offset
- current local time
Function GetTimeZone(lat As String, lng As String, Optional radius As Long = 10) As String()
Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFile As String
Dim tempString() As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim geoNames As Object ' MSXML2.IXMLDOMNode
Dim timeZone As Object ' MSXML2.IXMLDOMNode
Dim i As Long
tempFile = environ("temp") & "\geonamestimezone.xml"
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
xml.Open "GET", "http://ws.geonames.org/timezone?lat=" & _
lat & "&lng=" & lng & "&radius=" & radius & "&type=xml", False
xml.send
result = ConvertAccent(xml.responseText)
' create XML file from result
Call CreateFile(tempFile, result)
' create XML doc
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.async = False
.validateOnParse = False
.Load tempFile
End With
' check that the XML doc loaded
If LoadError(xmlDoc) Then
Exit Function
End If
' get first level nodes
Set geoNames = xmlDoc.childNodes(1)
Set timeZone = geoNames.childNodes(0)
' resize array
ReDim tempString(1 To timeZone.childNodes.Length)
For i = 1 To timeZone.childNodes.Length
tempString(i) = timeZone.childNodes(i - 1).nodeTypedValue
Next i
GetTimeZone = tempString
End Function
Sample usage
Sub TestGeoNames()
Dim tempString() As String
Dim i As Long
Dim lat As String, lng As String
lat = "47.03"
lng = "10.2"
tempString = GetTimeZone(lat, lng)
For i = LBound(tempString) To UBound(tempString)
Debug.Print tempString(i)
Next i
End Sub
Wikipedia search
Oddly, Geonames also offers a Wikipedia search. search for a word or query string and it returns up to ten matching results from Wikipedia.
For each result it returns
- matching result
- summary
- Wikipedia URL
The API returns much more information, but this is what I chose for the function to return.
Function WikipediaSearch(query As String, Optional numberOfResults As Long = 10) As String()
Dim xml As Object ' MSXML2.XMLHTTP
Dim result As String
Dim tempFile As String
Dim tempString() As String
Dim xmlDoc As Object ' MSXML2.DOMDocument
Dim geoNames As Object ' MSXML2.IXMLDOMNode
Dim entry As Object ' MSXML2.IXMLDOMNode
Dim i As Long, j As Long
tempFile = environ("temp") & "\geonameswikipediasearch.xml"
Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
xml.Open "GET", "http://ws.geonames.org/wikipediaSearch?q=" & _
query & "&maxRows=" & numberOfResults & "&type=xml", False
xml.send
result = ConvertAccent(xml.responseText)
' create XML file from result
Call CreateFile(tempFile, result)
' create XML doc
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
With xmlDoc
.async = False
.validateOnParse = False
.Load tempFile
End With
' check that the XML doc loaded
If LoadError(xmlDoc) Then
Exit Function
End If
' get first level nodes
Set geoNames = xmlDoc.childNodes(1)
' resize array
' we'll extract three nodes from each result node
ReDim tempString(1 To geoNames.childNodes.Length, 1 To 3)
For i = 1 To geoNames.childNodes.Length
Set entry = geoNames.childNodes(i - 1)
tempString(i, 1) = entry.childNodes(1).nodeTypedValue ' Title
tempString(i, 2) = entry.childNodes(2).nodeTypedValue ' Summary
tempString(i, 3) = entry.childNodes(9).nodeTypedValue ' URL
Next i
WikipediaSearch = tempString
End Function
Sample usage
This sample procedure returns the first ten matching results from Wikipedia for the term "London."
Sub TestGeoNames()
Dim tempString() As String
Dim i As Long, j As Long
tempString = WikipediaSearch("London")
For i = LBound(tempString) To UBound(tempString)
For j = LBound(tempString, 2) To UBound(tempString, 2)
Debug.Print tempString(i, j)
Next j
Next i
End Sub
COMBO : PAIS / STATE / CITY
http://du.somee.com/combo.asp
using : Geonames