无法点击某些点来刮取信息

Question

我在vba中结合IE编写了一个脚本,点击网页上地图上的一些点.单击一个点时,会弹出一个包含相关信息的小框.

链接到该网站

我想解析每个盒子的内容.可以使用类名找到该框的内容contentPane.但是,这里主要关注的是通过单击这些点来生成每个框.当一个框出现时,它看起来如下图所示.

这是我到目前为止尝试过的脚本:

Sub HitDotOnAMap()
    Const Url As String = "https://www.arcgis.com/apps/Embed/index.html?webmap=4712740e6d6747d18cffc6a5fa5988f8&extent=-141.1354,10.7295,-49.7292,57.6712&zoom=true&scale=true&search=true&searchextent=true&details=true&legend=true&active_panel=details&basemap_gallery=true&disable_scroll=true&theme=light"
    Dim IE As New InternetExplorer, HTML As HTMLDocument
    Dim post As Object, I&

    With IE
        .Visible = True
        .navigate Url
        While .Busy = True Or .readyState < 4: DoEvents: Wend
        Set HTML = .document
    End With

    Application.Wait Now + TimeValue("00:0:07")  ''the following line zooms in the slider
    HTML.querySelector("#mapDiv_zoom_slider .esriSimpleSliderIncrementButton").Click
    Application.Wait Now + TimeValue("00:0:04")

    With HTML.querySelectorAll("[id^='NWQMC_VM_directory_'] circle")
        For I = 0 To .Length - 1
            .item(I).Focus
            .item(I).Click
            Application.Wait Now + TimeValue("00:0:03")
            Set post = HTML.querySelector(".contentPane")
            Debug.Print post.innerText
            HTML.querySelector("[class$='close']").Click
        Next I
    End With
End Sub

当我执行上面的脚本时,看起来它运行顺利但没有任何反应(我的意思是,没有点击)并且它也没有抛出任何错误.最后它优雅地退出浏览器.

这就是当点击一个点时带有信息的框的方式.

虽然我在我的脚本中使用了硬编码延迟,但是一旦宏开始工作,它们就可以在以后修复.

问题:如何单击该地图上的每个点并从弹出框中收集相关信息？我只期望使用任何解决方案Internet Explorer

数据不是这里的主要关注点.我想知道IE在这种情况下如何工作,以便我可以在将来的情况下处理它们.IE以外的任何解决方案都不是我想要的.

Answer 1

无需点击每个点.Json文件包含所有详细信息,您可以根据需要提取.

安装JsonConverter

1. 下载最新版本
2. 将JsonConverter.bas导入项目(打开VBA编辑器,Alt + F11;文件>导入文件)添加字典参考/类
3. 对于仅限Windows,请包含对"Microsoft Scripting Runtime"的引用
4. 对于Windows和Mac,包括VBA-Dictionary

要添加的参考

在 此处下载示例文件.

码:

Sub HitDotOnAMap()

    Const Url As String = "https://www.arcgis.com/sharing/rest/content/items/4712740e6d6747d18cffc6a5fa5988f8/data?f=json"
    Dim IE As New InternetExplorer, HTML As HTMLDocument
    Dim post As Object, I&
    Dim data As String, colObj As Object

    With IE
        .Visible = True
        .navigate Url
        While .Busy = True Or .readyState < 4: DoEvents: Wend
        data = .document.body.innerHTML
        data = Replace(Replace(data, "<pre>", ""), "</pre>", "")
    End With

    Dim JSON As Object
    Set JSON = JsonConverter.ParseJson(data)
    Set colObj = JSON("operationalLayers")(1)("featureCollection")("layers")(1)("featureSet")

    For Each Item In colObj("features")


         For j = 1 To Item("attributes").Count - 1
                Debug.Print Item("attributes").Keys()(j), Item("attributes").Items()(j)

         Next
    Next
End Sub

产量