如何从Google Maps中抓取地址信息？
我正在尝试创建一个宏，它从Excel中提取地址列表，并将每个地址输入到Google Maps中。
然后，它将地址行、城市/邮政编码和国家从Google Maps拉回到Excel中。
它的工作原理是从Google Maps中抓取信息。
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回答 3
Stack Overflow用户
发布于 2018-12-22 17:19:02
地理编码API不再是“免费的”，尽管我实际上相信，如果你保持在一定的阈值内，使用计费帐户设置，你可以免费获取。作为一个新的版本(地图/API已经更新)，我认为期望这些API与实际的地图结合使用(但不要引用我的话)。
请注意以下事项：
1)在.click之后使用适当的等待页面加载和
While ie.Busy Or ie.readyState < 4: DoEvents: Wend2)使用.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
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的反馈:住宅：
.section-hero-header div.section-hero-header-descriptionStack Overflow用户
发布于 2018-12-23 11:18:30
此答案使用带有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
'Next Part
Else
Debug.Print "Error: " & Response.StatusCode & " - " & Response.Content
End If
End Function示例(打印国家，对于其他字段，请查看提名网站上示例中返回的JSON-String )：
Debug.Print GeocodeRequestNominatim("united nations headquarters,USA")("country")Stack Overflow用户
发布于 2018-12-22 02:35:32
在运行您的代码并检查谷歌的地址搜索结果后，通过引用Postal_Code-hero-header-subtitle类中的span标记，我能够检索到整个地址块‘市，省subtitle’。
在不对代码进行任何其他更改的情况下，在For-Each循环(该循环遍历小部件窗格小部件可见类)的上方添加以下行，并使用F8逐步执行代码。
Debug.Print IE.Document.getElementsByClassName("section-hero-header-subtitle")(0).getElementsByTagName("span")(0).innerTexthttps://stackoverflow.com/questions/53888446
复制相似问题
腾讯云开发者
