如何从谷歌地图中抓取地址信息？

Question

我正在尝试创建一个宏，它从 Excel 中提取地址列表并将每个地址输入到 Google 地图中。

然后，它将地址行、城市/邮编和国家/地区从 Google 地图拉回 Excel。

它可以从谷歌地图中抓取信息。

Sub AddressLookup() 

Application.ScreenUpdating = False

For i = 1 To Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

    Dim IE As InternetExplorer
    Dim itemELE As Object
    Dim address As String
    Dim city As String
    Dim country As String

    Set IE = New InternetExplorer
    IE.Visible = True
    IE.navigate "https://www.google.com/maps"

    Do
        DoEvents
    Loop Until IE.readyState = READYSTATE_COMPLETE

    Dim Search As MSHTML.HTMLDocument
    Set Search = IE.document

    Search.all.q.Value = Cells(i, 1).Value

    Dim ele As MSHTML.IHTMLElement
    Dim eles As MSHTML.IHTMLElementCollection

    Set eles = Search.getElementsByTagName("button")

    For Each ele In eles

            If ele.ID = "searchbox-searchbutton" Then
                ele.click
        Else
        End If

    Next ele

    For Each itemELE In IE.document.getElementsByClassName("widget-pane widget-pane-visible")
        address = itemELE.getElementsByClassName("section-hero-header-description")(0).getElementsByTagName("h1")(0).innerText
        city = itemELE.getElementsByClassName("section-hero-header-description")(0).getElementsByTagName("h2")(0).innerText
        country = itemELE.getElementsByClassName("section-hero-header-description")(0).getElementsByTagName("h2")(1).innerText

    Next

    Cells(i, 2).Value = Trim(address)
    Cells(i, 3).Value = Trim(city)
    Cells(i, 4).Value = Trim(country)

    MsgBox country

Next

Application.ScreenUpdating = True

End Sub

Answer 1

此答案使用 OpenStreetMap Nominatim API 和 VBA-Web WebRequest。

与使用Internet Explorerscraping 相反，这是为此目的而设计的（更快、更可靠、更多信息）。这也可以通过Geocode API 完成，但您需要一个 API-Key 并跟踪费用。

如果您使用https://nominatim.openstreetmap.org/search，请尊重他们的Usage Policy，但最好自己安装。

Public Function GeocodeRequestNominatim(ByVal sAddress As String) As Dictionary
    Dim Client As New WebClient
    Client.BaseUrl = "https://nominatim.openstreetmap.org/"

    Dim Request As New WebRequest
    Dim Response As WebResponse
    Dim address As Dictionary

    With Request
        .Resource = "search/"
        .AddQuerystringParam "q", sAddress
        .AddQuerystringParam "format", "json"
        .AddQuerystringParam "polygon", "1"
        .AddQuerystringParam "addressdetails", "1"
    End With
    Set Response = Client.Execute(Request)
    If Response.StatusCode = WebStatusCode.Ok Then
       Set address = Response.Data(1)("address")
       Set GeocodeRequestNominatim = address

       'Dim Part As Variant
       'For Each Part In address.Items
       '    Debug.Print Part
       'Next Part

    Else
      Debug.Print "Error: " & Response.StatusCode & " - " & Response.Content
    End If
End Function

示例（打印国家/地区，其他字段请查看提名网站示例中返回的 JSON-String）：

Debug.Print GeocodeRequestNominatim("united nations headquarters,USA")("country")

Answer 2

地理编码 API 不再“免费”，但我实际上相信通过结算帐户设置，如果您保持在某个阈值之内，您可以免费抓取。作为一个新版本（地图/API 已更新），我认为这些 API 与实际地图结合使用（但不要引用我的话）。

请注意以下几点：

1) 在.click

之后使用适当的等待页面加载和

While ie.Busy Or ie.readyState < 4: DoEvents: Wend

2) 使用.Navigate2 而不是.Navigate

3) 使用 id 更快地进行选择。它们通常是独一无二的，因此不需要循环

4) 在这种情况下，需要额外的时间来允许 url 更新和映射到缩放等。我为此添加了一个定时循环。我展示了一个例子，因为很明显你知道如何循环。

Option Explicit    
Public Sub GetInfo()
    Dim ie As New InternetExplorer, arr() As String, address As String, city As String, country As String
    Dim addressElement As Object, t As Date, result As String
    Const MAX_WAIT_SEC As Long = 10              '<==adjust time here
    With ie
        .Visible = True
        .Navigate2 "https://www.google.com/maps"

        While .Busy Or .readyState < 4: DoEvents: Wend

        With .document
            .querySelector("#searchboxinput").Value = "united nations headquarters,USA"
            .querySelector("#searchbox-searchbutton").Click
        End With

        While .Busy Or .readyState < 4: DoEvents: Wend

        t = Timer
        Do
            DoEvents
            On Error Resume Next
            Set addressElement = .document.querySelector(".section-info-line span.widget-pane-link")
            result = addressElement.innerText
            If Timer - t > MAX_WAIT_SEC Then Exit Do
            On Error GoTo 0
        Loop While addressElement Is Nothing
        If InStr(result, ",") > 0 Then
            arr = Split(result, ",")
            address = arr(0)
            city = arr(1)
            country = arr(2)

            With ActiveSheet
                .Cells(1, 2).Value = Trim$(address)
                .Cells(1, 3).Value = Trim$(city)
                .Cells(1, 4).Value = Trim$(country)
            End With
        End If
        Debug.Print .document.URL
        .Quit
    End With
End Sub

---

在选择器方面 -

商业地址：

.section-info-line span.widget-pane-link

以及来自 OP re: 住宅的反馈：

.section-hero-header div.section-hero-header-description

Answer 3

在运行您的代码并检查 Google 的地址搜索结果后，我能够通过引用 section-hero-header-subtitle 类中的 span 标签来检索整个地址块“City, Province Postal_Code”。

在不对代码进行任何其他更改的情况下，在 For-Each 循环（循环小部件窗格小部件窗格可见类）上方添加以下行并使用 F8 逐步执行代码。

Debug.Print IE.Document.getElementsByClassName("section-hero-header-subtitle")(0).getElementsByTagName("span")(0).innerText