Extrair coordenadas de marcadores do mapa do google incorporado

Muito novo para isso, então tenha paciência comigo. Estou precisando extrair as coordenadas do marcador de um mapa do google incorporado – um link de exemplo é http://www.picknpay.co.za/store-search e quero extrair todas as posições de marcadores geradas no mapa na pesquisa. Considerado o uso de serviços como o ParseHub, mas antes de seguir esse caminho, pensei em dar uma olhada através do SO / eu mesmo.

Tem que haver uma maneira mais fácil de encontrar as coordenadas para os marcadores armazenados no mapa do que passar manualmente por todas elas e procurar suas coordenadas individualmente?

A fonte HTML da página da Web pelo link fornecido http://www.picknpay.co.za/store-search não contém os dados necessários, ele usa o AJAX. O site http://www.picknpay.co.za tem uma API sorta disponível. A resposta é retornada no formato JSON. Navegue pela página, por exemplo, no Chrome, abra a janela Ferramentas do desenvolvedor ( F12 ), guia Rede, recarregue ( F5 ) a página e examine os XHRs registrados. A maioria dos dados relevantes é uma string JSON retornada pelo URL:

http://www.picknpay.co.za/picknpay/json/picknpay/en/modules/store_finder/findStores.json

Pré-visualização do XHR

Cabeçalhos XHR

Você pode usar o código VBA abaixo para recuperar informações conforme descrito acima. Importe o módulo JSON.bas no projeto VBA para processamento JSON.

Option Explicit Sub Scrape_picknpay_co_za() Dim sResponse As String Dim sState As String Dim vJSON As Variant Dim aRows() As Variant Dim aHeader() As Variant ' Retrieve JSON data XmlHttpRequest "POST", "http://www.picknpay.co.za/picknpay/json/picknpay/en/modules/store_finder/findStores.json", "", "", "", sResponse ' Parse JSON response JSON.Parse sResponse, vJSON, sState If sState <> "Array" Then MsgBox "Invalid JSON response" Exit Sub End If ' Convert result to arrays for output JSON.ToArray vJSON, aRows, aHeader ' Output With ThisWorkbook.Sheets(1) OutputArray .Cells(1, 1), aHeader Output2DArray .Cells(2, 1), aRows .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 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 

A saída para mim é a seguinte:

saída

BTW, a mesma abordagem aplicada nas seguintes respostas: 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 e 9 .