问 如何从Google Maps中抓取地址信息？

EN

地理编码API不再是“免费的”，尽管我实际上相信，如果你保持在一定的阈值内，使用计费帐户设置，你可以免费获取。作为一个新的版本(地图/API已经更新)，我认为期望这些API与实际的地图结合使用(但不要引用我的话)。

请注意以下事项：

1)在 .click 之后使用适当的等待页面加载 和

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

2)使用 .Navigate2 而不是 .Navigate

3)使用ids作为更快的选择。它们通常是唯一的，因此不需要循环

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
            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的反馈:住宅：

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

此答案使用带有 VBA-Web WebRequest的 OpenStreetMap Nominatim API 。

与 Internet Explorer 的抓取相反，这是为此目的而设计的(更快，更可靠，更多信息)。使用 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