|
|
相关文章推荐
|
酷酷的日光灯 · 探秘钱塘高中，筑梦未来之旅————杭州市钱塘 ...· 2 月前 · |
|
|
失望的针织衫 · Amazon.com· 2 月前 · |
|
|
内向的炒面 · 老钱日日谈 - 知乎· 6 月前 · |
|
|
八块腹肌的机器人 · 河南方言生僻字 - 知乎· 1 年前 · |
|
|
潇洒的野马 · 元朝到底是怎么被打败的？朱元璋出力最少，但却 ...· 1 年前 · |
如何从Google Maps中抓取地址信息？
问
如何从Google Maps中抓取地址信息？
EN
EN
Stack Overflow用户
提问于
2018-12-22 01:05:16
回答 3
查看 2.3K
关注 0
票数 0
我正在尝试创建一个宏，它从Excel中提取地址列表，并将每个地址输入到Google Maps中。
然后，它将地址行、城市/邮政编码和国家从Google Maps拉回到Excel中。
它的工作原理是从Google Maps中抓取信息。
代码语言：
javascript
复制
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"
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
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
Cells(i, 2).Value = Trim(address)
Cells(i, 3).Value = Trim(city)
Cells(i, 4).Value = Trim(country)
MsgBox country
Application.ScreenUpdating = True
End Sub
EN
回答 3
Stack Overflow用户
发布于 2018-12-22 17:19:02
地理编码API不再是“免费的”，尽管我实际上相信，如果你保持在一定的阈值内，使用计费帐户设置，你可以免费获取。作为一个新的版本(地图/API已经更新)，我认为期望这些API与实际的地图结合使用(但不要引用我的话)。
请注意以下事项：
1)在
.click
之后使用适当的等待页面加载
和
代码语言：
javascript
复制
While ie.Busy Or ie.readyState < 4: DoEvents: Wend
2)使用
.Navigate2
而不是
.Navigate
3)使用ids作为更快的选择。它们通常是唯一的，因此不需要循环
4)在这种情况下，需要额外的时间，以允许url更新和地图缩放等。我已经为此添加了一个定时循环。我给出一个简单的例子，因为很明显你知道如何循环。
代码语言：
javascript
复制
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
在选择器方面-
商业地址：
代码语言：
javascript
复制
.section-info-line span.widget-pane-link和来自OP的反馈:住宅：
代码语言：
javascript
复制
.section-hero-header div.section-hero-header-description
票数 1
EN
Stack 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 ，但最好有自己的安装。
代码语言：
javascript
复制
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