从嵌入的Google地图提取标记坐标 [英] Extracting marker coordinates from embedded google map

问题描述

这很适合我，我需要从嵌入的谷歌地图提取标记坐标 - 示例链接是

您可以使用下面的VBA代码来检索上述信息。 导入

顺便说一句，在以下答案中应用相同的方法： 1 ， 2 ， 3 ， 4 ， 5 ， 6 ， 7 ， 8 和9 。

Pretty new to this so bear with me. I am needing to extract marker coordinates from an embedded google map - an example link is http://www.picknpay.co.za/store-search and I want to extract all marker positions generated in the map on search. Considered using services such as ParseHub but before going that route I thought I'd give a shot through SO/myself.

There has to be an easier way of finding the coordinates for markers stored in the map than manually going through them all and searching for their coordinates individually?

解决方案

The webpage source HTML by the link provided http://www.picknpay.co.za/store-search doesn't contain the necessary data, it uses AJAX. The website http://www.picknpay.co.za has a sorta API available. Response is returned in JSON format. Navigate the page e. g. in Chrome, then open Developer Tools window (F12), Network tab, reload (F5) the page and examine logged XHRs. Most relevant data is JSON string returned by the URL:

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

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 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

The output for me is as follows:

BTW, the same approach applied in the following answers: 1, 2, 3, 4, 5, 6, 7, 8 and 9.

这篇关于从嵌入的Google地图提取标记坐标的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！