使用 Google 地理编码 API 进行 VBA 编程

Question

对于所有 MSFT 产品的爱好者来说，这可能非常简单，但 VBA 不是我的强项，我正在努力利用我拥有的资源......所以让我们把它变成一个学习的机会吧！我正在使用谷歌地理编码 API 为一组地址提供纬度/经度列表。

我正在使用 Jason Glover 为他的Police Tracker 发布的解决方案。基本上在 Excel 电子表格中，我有一堆地址，使用函数“=GoogleGeocode”我可以拉下纬度/经度。使用 Google 地理编码 API 一次处理多个地址。

使用 Google API，我能够生成 XML 结果以提取到 Excel 电子表格中。例如，The White House XML 将被拉入 lat/long of：

<geometry>
<location>
   <lat>38.8976094</lat>
   <lng>-77.0367349</lng>
</location>

我的问题，我想要的不仅仅是地址，我想要的是：地理编码（几何）、地址（formatted_address）和来自 XML 的精度（类型）。 如果有人能帮助我理解我应该如何从 XML 中提取我正在寻找的信息，我将不胜感激。

我尝试了几种不同的操作（在 Jason 提供的原始 XML 之下），但我似乎无法弄清楚。

Jason 的原始 VBA

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

尝试：

没有。 1 – 修改 XML 和 HTTP 组件/标题：我的想法是添加“oNode2”（格式化地址）和“oNode3”（类型），以便能够将 NodeList 分解为不仅仅是“几何”（地理编码)，而是使用零级 (0) 的 .ChildNodes 来拉取特定标签。那没用。

     '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

没有。 2 – 修改 XML 的深度。当时的想法是使用相同的“结果”主标头，然后使用 .ChildNode 深度 (x) 来确定要提取的 XML。徒劳无功。

我的另一个问题是我无法弄清楚为什么 Lat 是 .ChildNode(0) 对于两者来说，但 Long 是 (0)/(1)。我在想第一个是深度位置（“几何”深度为零），第二个是顺序位置（long 是第一个顺序 = 0，lat 是第二个顺序 = 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。这不是我的作业。 :P

Answer 1

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