问题:从嵌入式谷歌地图中提取标记坐标

对此很陌生,所以请多多包涵。我需要从嵌入式谷歌地图中提取标记坐标 - 一个示例链接是http://www.picknpay.co.za/store-search,我想提取地图中搜索时生成的所有标记位置。考虑使用 ParseHub 之类的服务,但在走这条路之前,我想我会通过 SO/myself 试一试。

必须有一种更简单的方法来查找存储在地图中的标记的坐标,而不是手动浏览所有标记并单独搜索它们的坐标?

解答

通过链接提供的网页源 HTMLhttp://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

您可以使用下面的 VBA 代码来检索如上所述的信息。 将JSON.bas模块导入VBA工程中进行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

我的输出如下:

顺便说一句,类似的方法在其他答案中应用了。