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

Question

因此，我有一个在单元格A2中开始的Excel中的商业名称列表，下拉到A3，A4等等。我需要做的是检索这些企业的地址，并返回它旁边的单元格中的地址（B2，B3，B4 ...）。

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

Answer 1

取决于你打算用这些数据做什么，Bing地图可能不是一个选择，因为terms of use有以下限制：

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

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

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 

确保你得到你自己的谷歌API密钥。

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

只是去上面的链接，点击上面写着“一键搞定”按钮。