Question

对于所有那些MSFT产品的爱好者来说，这个可能非常简单，但VBA不是我的强项，我正在尝试使用我拥有的资源......所以让我们学习这个机会吧！我正在使用Google地理编码API在一组Lat / Long上提供一定数量的地址。

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

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

拉入

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

我的问题，我想要的不仅仅是地址，我想要的是：XML中的地理编码（几何），地址（formatted_address）和精度（类型）。 如果有人可以帮助我了解我应该怎样做以从XML中提取我正在寻找的信息，我真的很感激。

我尝试了几种不同的动作（低于Jason提供的原始XML ），但我似乎无法弄明白。

杰森的原始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

ATTEMPS：

否。 1 - 修改XML＆amp; HTTP组件/标头：我的想法是添加“oNode2”（formatted_address）和“oNode3”（类型），以便能够将NodeList分解为不仅仅是“几何”（地理编码），而是使用.ChildNodes在级别零（0）以拉出特定标签。那没用。

     '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 depth（x）来确定要提取的XML。徒劳无功。

我的另一个问题是我无法弄清楚为什么Lat的两个都是.ChildNode（0），但Long是（0）/（1）。我认为第一个是深度位置（从“几何”开始为零深度），第二个是按顺序排列的位置（长度排在第一位= 0，纬度排在第二位= 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

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

杰森的原始VBA

ATTEMPS：

1 个答案: