Невозможно нажать на некоторые точки, чтобы очистить информацию - программирование
Подтвердить что ты не робот

Невозможно нажать на некоторые точки, чтобы очистить информацию

Я написал сценарий в 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

когда я выполняю вышеуказанный скрипт, похоже, что он работает плавно, но ничего не происходит (я имел в виду, не нажав), и он тоже не вызывает никаких ошибок. Наконец, он выходит из браузера изящно.

Вот как выглядит окно с информацией при щелчке точки.

enter image description here

Хотя я использовал задержку жесткого кодирования в моем скрипте, они могут быть исправлены позже, как только макрос начнет работать.

Вопрос: Как я могу щелкнуть каждую из точек на этой карте и собрать соответствующую информацию из всплывшего окна? Я только ожидаю, что у вас будет какое-либо решение с помощью Internet Explorer

Данные здесь не являются главной проблемой. Я хотел бы знать, как IE работает в таких случаях, чтобы я мог справиться с ними в будущих случаях. Любые решения, кроме IE, я не ищу.

4b9b3361

Ответ 1

Не нужно нажимать на каждую точку. В файле Json есть все подробности, и вы можете извлечь их согласно вашему требованию.


Установка JsonConverter

  1. Загрузите последнюю версию
  2. Импортируйте JsonConverter.bas в свой проект (Open VBA Editor, Alt + F11; File> Import File) Добавить словарь/класс
  3. Для Windows-only включите ссылку на "Время выполнения сценариев Microsoft",
  4. Для Windows и Mac включите VBA-словарь

Ссылки для добавления

enter image description here


Загрузите образец файла здесь.


Код:

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

Выход

enter image description here