对于所有 MSFT 产品爱好者来说,这可能非常简单,但 VBA 不是我的强项,我正在尝试利用我拥有的资源......所以让我们把这作为一个学习机会!我正在使用 Google 地理编码 API 来提供一组地址的纬度/经度列表。
我正在使用 Jason Glover 为其 Police Tracker 发布的解决方案。基本上在 Excel 电子表格中我有一堆地址,使用函数“=GoogleGeocode”我可以拉下纬度/经度。使用 Google 地理编码 API 一次获取多个地址。
使用 Google API,我能够生成 XML 结果以提取到 Excel 电子表格中。例如,The White House XML将被拉入纬度/经度:
<geometry>
<location>
<lat>38.8976094</lat>
<lng>-77.0367349</lng>
</location>
我的问题是,我想要的不仅仅是地址,我想要:XML 中的地理编码(几何)、地址(formatted_address)和精度(类型)。 如果有人可以帮助我了解应该如何从 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 组件/ header :我的想法是添加“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 的深度。我们的想法是使用相同的“结果”主 header ,然后使用 .ChildNode 深度 (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
最佳答案
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
关于xml - 使用 Google 地理编码 API 进行 VBA 编程,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/35354037/