【问题标题】:Extracting marker coordinates from embedded google map从嵌入式谷歌地图中提取标记坐标
【发布时间】:2017-10-29 01:53:33
【问题描述】:

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

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

【问题讨论】:

    标签: json vba excel google-maps web-scraping


    【解决方案1】:

    http://www.picknpay.co.za/store-search 提供的链接的网页源 HTML 不包含必要的数据,它使用 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
    

    我的输出如下:

    顺便说一句,类似的方法适用于in other answers

    【讨论】:

    • 感谢@omegastripes,按照这些说明,这就像一个魅力。我对 VBA 不太熟悉,该脚本中实际发生了什么?
    • @NickvR 代码中有主要步骤的cmets,请询问您是否需要对代码的某个部分进行任何解释。
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2015-11-18
    • 1970-01-01
    • 2010-12-05
    • 1970-01-01
    相关资源
    最近更新 更多