2017-05-28 399 views
1

對此很新,很耐心。我需要從嵌入式谷歌地圖提取標記座標 - 示例鏈接是http://www.picknpay.co.za/store-search,我想提取搜索時在地圖上生成的所有標記位置。考慮使用諸如ParseHub之類的服務,但在走這條路線之前,我認爲我會通過SO /自己來投籃。從嵌入谷歌地圖中提取標記座標

要找到存儲在地圖中的標記的座標,必須比手動遍歷所有座標並單獨搜索它們的座標要簡單一些嗎?

謝謝偷拍!

回答

2

網頁源代碼HTML提供的鏈接http://www.picknpay.co.za/store-search不包含必要的數據,它使用AJAX。網站http://www.picknpay.co.za有一個可用的API。響應以JSON格式返回。導航頁面e。 G。在Chrome中,然後打開開發工具窗口(F12),網絡選項卡,重新加載(F5)頁面並檢查記錄的XHR。最相關的數據是由URL返回的JSON字符串:

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

XHR-preview

XHR-headers

您可以使用下面的VBA代碼的上述檢索信息。 JSON.bas模塊導入JSON處理的VBA項目。

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 

對我來說,輸出如下:

output

順便說一句,在下面的答案適用相同的方法:123456789

+0

謝謝@巨蟒,這個工作就像一個魅力遵循這些說明。我對VBA不太熟悉,該腳本中實際發生了什麼? – NickvR

+0

@NickvR代碼中有關於主要步驟的註釋,請詢問您是否想要對代碼的某個部分進行任何解釋。 – omegastripes