Question

所以我在excel中有一个业务名称列表，从单元格A2开始，一直到A3，A4等等。我需要做的是检索这些业务的地址，并在其旁边的单元格中返回地址（B2，B3，B4 ......）。

我有数千个商家名称，因此我不想手动执行此操作。有没有办法搜索业务的Web / Google / Bing地图，并使用VBA返回相应的地址。如果没有，是否还有其他方法可以用来填充我的Excel表格？

Answer 1

根据您要对此数据执行的操作，Bing地图可能不是一个选项，因为terms of use具有以下限制：

3.2 （h）使用由兴趣点数据组成的内容，以ASCII或其他类别特定商业列表的文本格式列表的形式生成销售线索信息，其中（i）包括每个企业的完整邮寄地址; （ii）包含特定国家，城市，州或邮政编码区域的大部分此类列表。

如果谷歌地图有类似的限制，我不会感到惊讶。

Answer 2

这适合我。

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("A1:A5")

    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_specific_key_goes_here" '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

确保获得自己的Google API密钥。

https://developers.google.com/maps/documentation/javascript/get-api-key

只需转到上面的链接，然后点击“获取密钥”按钮。

如何使用VBA，Excel在Google上搜索公司名称和返回地址

2 个答案: