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

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 i As Long

Dim mystring As String

GeoCoding = False

XMLDoc.Load "" & lat & "&lng=" & lng

Do Until XMLDoc.ReadyState = 4



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 = ""

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


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