VBA Programing with Google Geocoding API

Question

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.

Original VBA from Jason

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

ATTEMPS:

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

I think VB. This is being done through an Excel Spreadsheet. I'm saving it as a module(.xlam). Does that help/clarify? :/ — user2659035, Feb 12 '16 at 03:01

Vincent Saelzler · Accepted Answer · 2016-02-12T22:22:52.743

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

VBA Programing with Google Geocoding API

Original VBA from Jason

ATTEMPS:

1 Answers1