如何使用VBA和Google API密钥检索地址全名?

时间:2019-02-14 13:55:07

标签: excel vba google-api

我正在努力使用当前使用的VBA代码检索完整的地址名称,

我认为我的问题出在street_number部分,但是当我将其更改为long_name时,则不会生成任何结果。

我是VBA的新手,对于此问题的任何帮助将不胜感激。谢谢

Sub myTest()
Dim xhrRequest As XMLHTTP60
Dim domDoc As DOMDocument60
Dim domDoc2 As DOMDocument60
Dim placeID As String
Dim query As String
Dim nodes As IXMLDOMNodeList
Dim node As IXMLDOMNode
Dim rng As Range, cell As Range
Set rng = Range("B1")

For Each cell In rng

'you have to replace spaces with +
query = cell.Value

'You must acquire a google api key and enter it here
Dim googleKey As String
googleKey = "Your API key" 'your api key here

'Send a "GET" request for place/textsearch
Set xhrRequest = New XMLHTTP60

xhrRequest.Open "GET", "https://maps.googleapis.com/maps/api/place/textsearch/xml?" & _
    "query=" & query & "&key=" & googleKey, False
xhrRequest.send

'Save the response into a document
Set domDoc = New DOMDocument60
domDoc.LoadXML xhrRequest.responseText

'Find the first node that is called "place_id" and is the child of the "result" node
placeID = domDoc.SelectSingleNode("//result/place_id").Text

'recycling objects (could just use new ones)
Set domDoc = Nothing
Set xhrRequest = Nothing

'Send a "GET" request for place/details
Set xhrRequest = New XMLHTTP60
xhrRequest.Open "GET", "https://maps.googleapis.com/maps/api/place/details/xml?placeid=" & placeID & _
"&key=" & googleKey, False
xhrRequest.send

'Save the response into a document
Set domDoc = New DOMDocument60
domDoc.LoadXML xhrRequest.responseText

Dim output As String
Dim s As String

'hacky way to get postal code, you might want to rewrite this after learning more
Set nodes = domDoc.SelectNodes("//result/address_component/type")
For Each node In nodes
    s = node.Text
    If s = "street_number" Then
        'this is bad, you should search for "long_name", what i did here was assume that "long_name was the first child"
        'output = vbNewLine & "Postal Code: " & node.ParentNode.FirstChild.Text
        cell.Offset(0, 1).Value = "Address: " & node.ParentNode.FirstChild.Text
    End If

    If s = "postal_code" Then
        'this is bad, you should search for "long_name", what i did here was assume that "long_name was the first child"
        'output = vbNewLine & "Postal Code: " & node.ParentNode.FirstChild.Text
        cell.Offset(0, 2).Value = "Postal Code: " & node.ParentNode.FirstChild.Text
    End If
Next node

Next cell
'output
'MsgBox "Formatted Address: " & domDoc.SelectSingleNode("//result/formatted_address").Text & output
End Sub

我得到的回报:

enter image description here

我需要的是

enter image description here

1 个答案:

答案 0 :(得分:0)

也许只是将整个地址作为一个块取回:

Set nodes = domDoc.SelectNodes("//result/*")
For Each node In nodes
    s = node.Text
    If node.nodeName = "formatted_address" Then
        cell.Offset(0, 1).Value = "Address: " & s
    End If
Next node