For all those lovers of MSFT Products this one is probably super easy, but VBA is not my forte and I'm trying to work with the resources I have... so let's make this a learning opportunity! I'm using a Google Geocoding API to deliver on a list of Lat/Longs for a set number of address.
I'm using the solution posted by Jason Glover for his Police Tracker. Basically in an Excel Spreadsheet I have a bunch of addresses, using the function "=GoogleGeocode" I am able to pull down the Lat./Long. of several addresses at once using a Google Geocoding API.
Using the Google API I'm able to generate XML result for extraction into an excel spreadsheet. For example, The White House XML would be pulled in with lat/long of:
<geometry>
<location>
<lat>38.8976094</lat>
<lng>-77.0367349</lng>
</location>
My problem, I want more than just address, I want: the geocode (geometry), the address (formatted_address), and the precision (type) from the XML. If someone could help me understand what I should do to extract the information I’m looking for from the XML I’d really appreciate it.
I’ve tried several different maneuvers (below the original XML provided by Jason), but I can’t seem to figure it out.
Function GoogleGeocode(address As String) As String
Dim strAddress As String
Dim strQuery As String
Dim strLatitude As String
Dim strLongitude As String
strAddress = URLEncode(address)
'Assemble the query string
strQuery = "https://maps.googleapis.com/maps/api/geocode/xml?"
strQuery = strQuery & "address=" & strAddress
strQuery = strQuery & “&key=[ OMITTED]”
strQuery = strQuery & "&sensor=false"
'define XML and HTTP components
Dim googleResult As New MSXML2.DOMDocument
Dim googleService As New MSXML2.XMLHTTP
Dim oNodes As MSXML2.IXMLDOMNodeList
Dim oNode As MSXML2.IXMLDOMNode
'create HTTP request to query URL - make sure to have
'that last "False" there for synchronous operation
googleService.Open "GET", strQuery, False
googleService.send
googleResult.LoadXML (googleService.responseText)
Set oNodes = googleResult.getElementsByTagName("geometry")
If oNodes.Length = 1 Then
For Each oNode In oNodes
strLatitude = oNode.ChildNodes(0).ChildNodes(0).Text
strLongitude = oNode.ChildNodes(0).ChildNodes(1).Text
GoogleGeocode = strLatitude & "," & strLongitude
Next oNode
Else
GoogleGeocode = "Not Found or Too Fast”
End If
End Function
Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
Dim StringLen As Long: StringLen = Len(StringVal)
If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim Char As String, Space As String
If SpaceAsPlus Then Space = "+" Else Space = "%20"
For i = 1 To StringLen
Char = Mid$(StringVal, i, 1)
CharCode = Asc(Char)
Select Case CharCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
result(i) = Char
Case 32
result(i) = Space
Case 0 To 15
result(i) = "%0" & Hex(CharCode)
Case Else
result(i) = "%" & Hex(CharCode)
End Select
Next i
URLEncode = Join(result, "")
End If
End Function
No. 1 – Modifying the XML & HTTP Components/Headers: My thought was to add in “oNode2” (formatted_address) and “oNode3” (type) to be able to break up the NodeList into not just “geometry” (geocode), but instead use use the .ChildNodes at level zero (0) to pull the specific tags. That didn’t work.
'define XML and HTTP components
Dim googleResult As New MSXML2.DOMDocument
Dim googleService As New MSXML2.XMLHTTP
Dim oNodes As MSXML2.IXMLDOMNodeList
Dim oNode As MSXML2.IXMLDOMNode
Dim oNode2 As MSXML2.IXMLDOMNode 'My Addition
Dim oNode3 As MSXML2.IXMLDOMNode 'My Addition
//////////////////////////////////////////////////////
For Each oNode2 In oNodes
strNewAddress = oNode2.ChildNodes(0).ChildNodes(0).Text 'My Addition
strType = oNode3.ChildNodes(0).ChildNodes(0).Text 'My Addition
No. 2 – Modifying the Depth of the XML. The thought was to use the same “results” main header, then using the .ChildNode depth (x) to determine the XML for extraction. No avail.
My other problem was I couldn’t figure out why the Lat was .ChildNode(0) for both, but the Long was at (0)/(1). I was thinking the first was the location in depth (zero deep from “geometry”), the second was the location in order (long was first in order = 0, lat was second in order = 1).
Set oNodes = googleResult.getElemetsByTagName(“result”)
If oNodes.Length = 1 Then
For Each oNode In oNodes
strLatitude = oNode.ChildNodes(9).ChildNodes(0).Text
strLongitude = oNode.ChildNodes(9).ChildNodes(1).Text
strNewAddress = oNode.ChildNodes(0).ChildNodes(1).Text
strType = oNode.ChildNodes(0).ChildNodes(0).Text
GoogleGeocode = strLatitude & ";" & strLongitude & “;” & strNewAddress & “;” & strType
Next oNode
Else
GoogleGeocode = "Not Found or Too Fast”
End If
PS. This not my homework. :P
Function GoogleGeocode(QryAddr As String) As String
'NN = node name
Const RspnsStat As String = "status"
Const AddrType As String = "type"
Const FormAddr As String = "formatted_address"
Const Lat As String = "lat"
Const Lng As String = "lng"
Const Delim As String = ";"
'make the API call
Dim GeocodeResponseDoc As MSXML2.DOMDocument
Set GeocodeResponseDoc = GetGoogleAddrDoc(QryAddr)
'retreive info or display an error
Select Case GetNodeTextByName(GeocodeResponseDoc, RspnsStat)
Case "OK"
'Debug.Print (GetNodeTextByName(GeocodeResponseDoc, AddrType))
'Debug.Print (GetNodeTextByName(GeocodeResponseDoc, FormAddr))
'Debug.Print (GetNodeTextByName(GeocodeResponseDoc, Lat))
'Debug.Print (GetNodeTextByName(GeocodeResponseDoc, Lng))
'send info
Dim StrResult As String
StrResult = GetNodeTextByName(GeocodeResponseDoc, Lat) & "," & GetNodeTextByName(GeocodeResponseDoc, Lng)
StrResult = StrResult & Delim & GetNodeTextByName(GeocodeResponseDoc, AddrType)
StrResult = StrResult & Delim & GetNodeTextByName(GeocodeResponseDoc, FormAddr)
GoogleGeocode = StrResult
Case "ZERO_RESULTS"
GoogleGeocode = "No Results Found"
Case "OVER_QUERY_LIMIT"
GoogleGeocode = "OVER_QUERY_LIMIT"
Case Else
GoogleGeocode = GetNodeTextByName(GeocodeResponseDoc, RspnsStat)
End Select
End Function
Public Function GetGoogleAddrDoc(DirtyAddr As String) As MSXML2.DOMDocument
Dim CleanAddr As String
Dim UrlQry As String
Dim GoogleResult As New MSXML2.DOMDocument
Dim GoogleService As New MSXML2.XMLHTTP
'convert things like spaces to URL-safe chars
CleanAddr = URLEncode(DirtyAddr)
'Assemble the query string
UrlQry = "https://maps.googleapis.com/maps/api/geocode/xml?"
UrlQry = UrlQry & "&address=" & CleanAddr
UrlQry = UrlQry & "&sensor=false"
'open connection and load XML to the document
GoogleService.Open "GET", UrlQry, False
GoogleService.send
GoogleResult.LoadXML (GoogleService.responseText)
Set GetGoogleAddrDoc = GoogleResult
End Function
Public Function GetNodeTextByName(GeocodeResponseDoc As MSXML2.DOMDocument, NodeName As String) As String
'this is loosely coded and could be error prone, for example using "address_component" causes weird results
'root cause of issues is when one there are multiple instances of the same tag in the document
GetNodeTextByName = GeocodeResponseDoc.getElementsByTagName(NodeName)(0).Text
End Function
Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
Dim StringLen As Long: StringLen = Len(StringVal)
If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim Char As String, Space As String
If SpaceAsPlus Then Space = "+" Else Space = "%20"
For i = 1 To StringLen
Char = Mid$(StringVal, i, 1)
CharCode = Asc(Char)
Select Case CharCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
result(i) = Char
Case 32
result(i) = Space
Case 0 To 15
result(i) = "%0" & Hex(CharCode)
Case Else
result(i) = "%" & Hex(CharCode)
End Select
Next i
URLEncode = Join(result, "")
End If
End Function