Extract data locations from map - json

Question

I want to extract data from a map then get and store the locations all charging station in a specific state. (eg: https://www.plugshare.com/)
How can this be done? I don't mind using any programming language but which one is the best one for this application?

Answer 1

You can retrieve the data directly from https://www.plugshare.com with XHRs. You have to look into a little how does a website work to scrape the data. For any dynamically loaded data you just inspect XHRs the webpage does, find the one containing the relevant data, make the same XHR (either site provides API or not) and parse response. Navigate the page e. g. in Chrome, then open Developer Tools window (F12), Network tab, reload F5 the page and examine XHRs in the list.
There is one of the requests to URL https://www.plugshare.com/api/locations/region?... that returns latitude, longitude and other info for charging stations in a rectangle viewport area with specified coordinates. You can find URL, query parameters and some necessary headers as shown below:
Response is in JSON format:
You need to add basic authorization header to request. To retrieve the credentials go to Sources tab, add XHR Breakpoint for URL contains https://www.plugshare.com/api/locations/region, reload F5 the page, when the page is paused on XHR, follow the Call Stack frame by frame:
Skip any NREUM and nrWrapper objects that are the part of New Relic functionality. Click pretty-print {} to format source. Search e. g. Basic, Authorization or setRequestHeader in the sources, for that particular case first match is found in https://www.plugshare.com/js/main.js?_=1:
Click a station on the map and you get one more XHR appeared with URL like https://www.plugshare.com/api/locations/[id] with detailed information for that station, as shown below:
Response is in JSON format also:
Also you may get data for stations from URL like https://www.plugshare.com/api/stations/[id].
You may use the below VBA code to retrieve info as described above. Import JSON.bas module into the VBA project for JSON processing.
Option Explicit
Sub Test_www_plugshare_com()
Const Transposed = False ' Output option
Const Detailed = True ' Scrape option
Dim sResponse As String
Dim aQryHds()
Dim oQuery As Object
Dim sQuery As String
Dim vRegionJSON
Dim sState As String
Dim aResult()
Dim i As Long
Dim vLocationJSON
Dim aRows()
Dim aHeader()
' Retrieve auth token
XmlHttpRequest "GET", "https://www.plugshare.com/js/main.js?_=1", "", "", "", sResponse
With RegExMatches(sResponse, "var s\=""(Basic [^""]*)"";") ' var s="Basic *";
If .Count > 0 Then
aQryHds = Array( _
Array("Authorization", .Item(0).SubMatches(0)), _
Array("Accept", "application/json") _
)
Else
MsgBox "Can't retrieve auth token"
Exit Sub
End If
End With
' Set query parameters
Set oQuery = CreateObject("Scripting.Dictionary")
With oQuery
.Add "minimal", "1"
.Add "count", "500"
.Add "latitude", "19.697593650121235"
.Add "longitude", "-155.06529816792295"
.Add "spanLng", "0.274658203125"
.Add "spanLat", "0.11878815323507652"
.Add "access", "1,3"
.Add "outlets", "[{""connector"":1},{""connector"":2},{""connector"":3},{""connector"":4},{""connector"":5},{""connector"":6,""power"":0},{""connector"":6,""power"":1},{""connector"":7},{""connector"":8},{""connector"":9},{""connector"":10},{""connector"":11},{""connector"":12},{""connector"":13},{""connector"":14},{""connector"":15}]"
.Add "fast", "add"
End With
sQuery = EncodeQueryParams(oQuery)
' Retrieve a list of stations for the viewport
XmlHttpRequest "GET", "https://www.plugshare.com/api/locations/region?" & sQuery, aQryHds, "", "", sResponse
' Parse JSON response
JSON.Parse sResponse, vRegionJSON, sState
If sState <> "Array" Then
MsgBox "Invalid JSON response"
Exit Sub
End If
' Populate result array
ReDim aResult(UBound(vRegionJSON))
' Extract selected properties from parsed JSON
For i = 0 To UBound(aResult)
Set aResult(i) = ExtractKeys(vRegionJSON(i), Array("id", "name", "latitude", "longitude"))
DoEvents
Next
If Detailed Then
' Populate result array with detailed info for each location
For i = 0 To UBound(aResult)
' Retrieve detailed info for each location
XmlHttpRequest "GET", "https://www.plugshare.com/api/locations/" & aResult(i)("id"), aQryHds, "", "", sResponse
' Parse JSON response
JSON.Parse sResponse, vLocationJSON, sState
If sState = "Object" Then
' Extract selected properties from parsed JSON
Set aResult(i) = ExtractKeys(vLocationJSON, Array("reverse_geocoded_address", "hours", "phone", "description"), aResult(i))
End If
DoEvents
Next
End If
' Convert resulting array to arrays for output
JSON.ToArray aResult, aRows, aHeader
' Output
With ThisWorkbook.Sheets(1)
.Cells.Delete
If Transposed Then
Output2DArray .Cells(1, 1), WorksheetFunction.Transpose(aHeader)
Output2DArray .Cells(1, 2), WorksheetFunction.Transpose(aRows)
Else
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aRows
End If
.Columns.AutoFit
End With
MsgBox "Completed"
End Sub
Sub XmlHttpRequest(sMethod As String, sUrl As String, arrSetHeaders, sFormData, sRespHeaders As String, sContent As String)
Dim arrHeader
'With CreateObject("Msxml2.ServerXMLHTTP")
' .SetOption 2, 13056 ' SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS
With CreateObject("MSXML2.XMLHTTP")
.Open sMethod, sUrl, False
If IsArray(arrSetHeaders) Then
For Each arrHeader In arrSetHeaders
.SetRequestHeader arrHeader(0), arrHeader(1)
Next
End If
.send sFormData
sRespHeaders = .GetAllResponseHeaders
sContent = .responseText
End With
End Sub
Function RegExMatches(sText, sPattern, Optional bGlobal = True, Optional bMultiLine = True, Optional bIgnoreCase = True) As Object
With CreateObject("VBScript.RegExp")
.Global = bGlobal
.MultiLine = bMultiLine
.IgnoreCase = bIgnoreCase
.Pattern = sPattern
Set RegExMatches = .Execute(sText)
End With
End Function
Function EncodeQueryParams(oParams As Object) As String
Dim aParams
Dim i As Long
aParams = oParams.Keys()
For i = 0 To UBound(aParams)
aParams(i) = EncodeUriComponent((aParams(i))) & "=" & EncodeUriComponent((oParams(aParams(i))))
Next
EncodeQueryParams = Join(aParams, "&")
End Function
Function EncodeUriComponent(strText As String) As String
Static objHtmlfile As Object
If objHtmlfile Is Nothing Then
Set objHtmlfile = CreateObject("htmlfile")
objHtmlfile.parentWindow.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
End If
EncodeUriComponent = objHtmlfile.parentWindow.encode(strText)
End Function
Function ExtractKeys(oSource, aKeys, Optional oTarget = Nothing) As Object
Dim vKey
If oTarget Is Nothing Then Set oTarget = CreateObject("Scripting.Dictionary")
For Each vKey In aKeys
If oSource.Exists(vKey) Then
If IsObject(oSource(vKey)) Then
Set oTarget(vKey) = oSource(vKey)
Else
oTarget(vKey) = oSource(vKey)
End If
End If
Next
Set ExtractKeys = oTarget
End Function
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Change to Const Detailed = False if you have a lot of items for output to prevent application hanging, since XHRs are in synchronous mode. The output for me with specified viewport coordinates is as follows:
BTW, the similar approach applied in other answers.