VBA 使用 Google 地理编码进行编程 API
VBA Programing with Google Geocoding API
对于 MSFT 产品的所有爱好者来说，这可能非常简单，但 VBA 不是我的强项，我正在尝试使用我拥有的资源...所以让我们把它作为一种学习机会！我正在使用 Google 地理编码 API 为一组地址提供 Lat/Longs 列表。
我正在使用 Jason Glover 为他的 Police Tracker 发布的解决方案。基本上在 Excel 电子表格中我有一堆地址，使用函数“=GoogleGeocode”我能够拉下 Lat./Long。使用 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
ATTEMPS:
没有。 1 – 修改 XML 和 HTTP Components/Headers：我的想法是添加“oNode2”（formatted_address）和“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 的深度。当时的想法是使用相同的“结果”main header，然后使用 .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
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
对于 MSFT 产品的所有爱好者来说，这可能非常简单，但 VBA 不是我的强项，我正在尝试使用我拥有的资源...所以让我们把它作为一种学习机会！我正在使用 Google 地理编码 API 为一组地址提供 Lat/Longs 列表。
我正在使用 Jason Glover 为他的 Police Tracker 发布的解决方案。基本上在 Excel 电子表格中我有一堆地址，使用函数“=GoogleGeocode”我能够拉下 Lat./Long。使用 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
的原创 VBAFunction 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 和 HTTP Components/Headers：我的想法是添加“oNode2”（formatted_address）和“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 的深度。当时的想法是使用相同的“结果”main header，然后使用 .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
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