如何使用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

只是去上面的鏈接，點擊上面寫着「一鍵搞定」按鈕。