Geography and IP address in VBA

I have came accross a problem in VBA where I needed to automate the default location entered in a billing system. For instance entering a customer city.

Some xml services can be used in combination with excel vba to accomplish such a task.

What I found is that the problem could be splitted in 2 tasks. The first tasks involved going from an IP address to one Longitude and Latitude. Then afterward one can find the nearest big city using those 2 information.

To get the Longitude and latitude in VBA, one can use those functions. To go from latitude to longitude to a city name, one would need to use some web services such as http://www.geonames.org/

Sub testcityname()

Dim myarray As Variant

Dim mycity As Variant

Dim latitude As Double

Dim longitude As Double

myarray = GetLatLonbyIP

latitude = myarray(2)

longitude = myarray(3)

GeoCoding latitude, longitude

End Sub

Function GetMSXML() As Object ' MSXML2.XMLHTTP60

On Error Resume Next

Set GetMSXML = CreateObject("MSXML2.XMLHTTP.6.0")

End Function

Function GetDomDoc() As Object ' MSXML2.DOMDocument

On Error Resume Next

Set GetDomDoc = CreateObject("MSXML2.DOMDocument.6.0")

End Function

Function GetNode(parentNode As Object, nodeNumber As Long) As Object

On Error Resume Next

' if parentNode is a MSXML2.IXMLDOMNodeList

Set GetNode = parentNode.Item(nodeNumber - 1)

' if parentNode is a MSXML2.IXMLDOMNode

If GetNode Is Nothing Then

Set GetNode = parentNode.childNodes(nodeNumber - 1)

End If

End Function

Function GeoCoding(lat As Double, lng As Double) As String

Dim XMLDoc As New DOMDocument

Dim XMLNode As IXMLDOMNode

Dim i As Long

Dim mystring As String

GeoCoding = False

XMLDoc.Load "http://ws.geonames.org/findNearestAddress?lat=" & lat & "&lng=" & lng

Do Until XMLDoc.ReadyState = 4

DoEvents

Loop

If Len(XMLDoc.Text) = 0 Then

GeoCoding = False

Exit Function

End If

Set XMLNode = XMLDoc.selectSingleNode("//geonames/address")

For i = 0 To XMLNode.childNodes.length - 1

mystring = XMLNode.childNodes(i).baseName & ": " & XMLNode.childNodes(i).Text

Next i

GeoCoding = mystring

End Function

Function GetLatLonbyIP(Optional ipaddress As String) As String()

' returns IP, latitude and longitude for a given IP address

' returns latitude and longitude for current IP address if not specified

Dim url As String

Dim xml As Object ' MSXML2.XMLHTTP60

Dim XMLDoc As Object ' MSXML2.DOMDocument60

Dim items As Object ' MSXML2.IXMLDOMNode

Dim ip As Object ' MSXML2.IXMLDOMNode

Dim location As Object ' MSXML2.IXMLDOMNode

Dim coords As Object ' MSXML2.IXMLDOMNode

Dim lat As Object ' MSXML2.IXMLDOMNode

Dim lon As Object ' MSXML2.IXMLDOMNode

Dim latlon(1 To 3) As String

Const BASE_URL As String = "http://geoip.prototypeapp.com/api/locate?format=xml"

Set xml = GetMSXML

Set XMLDoc = GetDomDoc

If xml Is Nothing Then Exit Function

If XMLDoc Is Nothing Then Exit Function

' build URL depending on whether IP was specified

If Len(ipaddress) = 0 Then

url = BASE_URL

Else ' add IP address

url = BASE_URL & "&ip=" & ipaddress

End If

With xml

.Open "GET", url

.send

End With

' load file into document object

XMLDoc.loadXML xml.responseText

' walk the node hierarchy

Set items = GetNode(XMLDoc, 2)

' first subnode contains IP address

Set ip = GetNode(items, 1)

' location node contains lat and lon

Set location = GetNode(items, 3)

Set coords = GetNode(location, 1)

Set lat = GetNode(coords, 1)

Set lon = GetNode(coords, 2)

latlon(1) = ip.nodeTypedValue

latlon(2) = lat.nodeTypedValue

latlon(3) = lon.nodeTypedValue

GetLatLonbyIP = latlon

End Function