How to scrape address information from Google Maps? - html

Question

I'm trying to create a macro that pulls a list of addresses from Excel and inputs each one into Google Maps.
It then pulls the address line, city/zip and country from Google Maps back into Excel.
It works up to the point where it scrapes the information from 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

Answer 1

This answer uses the OpenStreetMap Nominatim API with the VBA-Web WebRequest.
In opposite to scraping withInternet Explorerthis is designed for this purpose (faster, more reliable, more information). This can be done with the Geocode API too, but you need an API-Key and keep track of the cost.
If you use https://nominatim.openstreetmap.org/search respect their Usage Policy, but better have your own installation.
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
Example (prints country, for other fields have a look at the returned JSON-String in example on Nomination Website):
Debug.Print GeocodeRequestNominatim("united nations headquarters,USA")("country")

Answer 2

The geocoding API is no longer "free" though I actually believe with a billing account set-up you can scrape for free if you remain within a certain threshold. As a new release (maps/APIs has been updated) I think the expectation is that these APIs are used in conjunction with actual maps (but don't quote me on that).
Please note the following:
1) Use a proper wait for page load and after .click
While ie.Busy Or ie.readyState < 4: DoEvents: Wend
2) Use .Navigate2 rather than .Navigate
3) Use ids as faster for selections. They generally are unique so no looping required
4) In this case additional time is needed to allow for url to update and map to zoom etc. I have added a timed loop for this. I show a single example as it is clear you know how to loop.
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
In terms of selectors -
Commercial addresses:
.section-info-line span.widget-pane-link
And feedback from OP re: residential:
.section-hero-header div.section-hero-header-description

Answer 3

After running your code and inspecting Google's address search result, I was able to retrieve the entire address block 'City, Province Postal_Code' by referencing the span tag inside the section-hero-header-subtitle class.
Without making any other changes to your code, add the following line above your For-Each loop (that loops through widget-pane widget-pane visible class) and step thru the code using F8.
Debug.Print IE.Document.getElementsByClassName("section-hero-header-subtitle")(0).getElementsByTagName("span")(0).innerText