Extrahieren von Marker-Koordinaten aus dem eingebetteten Google-Karte

Question

Ziemlich neu zu diesem tragen so mit mir. Ich muss Markerkoordinaten aus einer eingebetteten Google Map extrahieren - ein Beispiellink ist http://www.picknpay.co.za/store-search und ich möchte alle Markerpositionen extrahieren, die in der Karte bei der Suche generiert wurden. Betrachtet mit Diensten wie ParseHub, aber bevor ich diese Route ging, dachte ich, ich würde SO/mich selbst durchspielen.

Es muss einen einfacheren Weg geben, die Koordinaten für Marker zu finden, die in der Karte gespeichert sind, als sie manuell durchzugehen und einzeln nach ihren Koordinaten zu suchen?

Danke peeps!

Answer 1

Die Webseite HTML-Quelle durch den angegebenen Link http://www.picknpay.co.za/store-search enthält nicht die notwendigen Daten, verwendet AJAX. Die Webseite http://www.picknpay.co.za hat eine sorta API zur Verfügung. Die Antwort wird im JSON-Format zurückgegeben. Navigieren Sie zur Seite e. G. Öffnen Sie in Chrome das Developer Tools-Fenster (F12), Registerkarte Netzwerk, laden Sie die Seite neu und überprüfen Sie die protokollierten XHRs (F5). Die meisten relevanten Daten ist JSON-String in der URL zurückgegeben:

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

Sie die folgenden VBA-Code verwenden können Informationen abgerufen werden, wie oben beschrieben. Importieren Sie das Modul JSON.bas in das VBA-Projekt für die JSON-Verarbeitung.

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 

Der Ausgang ist für mich wie folgt:

BTW, der gleiche Ansatz in den folgenden Antworten angewendet: 1, 2, 3, 4, 5, 6, 7, 8 und 9.