Использование Excel VBA для использования поля поиска, запуска события клика и получения результатов? - PullRequest
0 голосов
/ 19 февраля 2019

После поиска в каждой теме, которую я мог найти по этой теме, и после ошибки я пришел сюда в надежде, что кто-нибудь может мне помочь.

Я пытаюсь использовать этот веб-сайт, https://azredistricting.org/districtlocator/, для поиска адресов, которые возвращают законодательный / конгрессный округ.

Я попытался изменить следующий код:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = Range("address").Row And _
Target.Column = Range("address").Column Then
   Dim ie As New InternetExplorer

   ie.navigate "https://azredistricting.org/districtlocator/"
   ie.Visible = True

   While ie.Busy
   DoEvents
   Wend

   ie.document.getElementById("txtAddress").Value = Range("address")

   While ie.Busy
   DoEvents
   Wend


   Dim Doc As HTMLDocument
    Set Doc = ie.document
    Dim sDD As String
    sDD = Trim(Doc.GetElementsByID("districts").innerText)
    MsgBox sDD

End If

Я продолжаю сталкиваться с ошибками 424 времени выполнения и еще 400 уровнем, связанным со строками.

HTML-код Iопределил и пытаюсь использовать

<input name="txtAddress" type="text" id="txtAddress" style="color:#214670;background-color:#FFFF99;border-color:#FF3300;border-width:1px;border-style:Solid;font-weight:bold;width:360px;margin-bottom: 0px">

с

<input type="button" value="Find" onclick="codeAddress()" class="gsc-search-button" title="Enter your address and click here to find your districts">

и извлекаю строку из

<big>29</big>

В любом случае, я полностью потерян иЯ готов бросить полотенце и просто вручную 10-ключ этого списка.Любая помощь будет оценена.

1 Ответ

0 голосов
/ 19 февраля 2019

Internet Explorer:

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

Option Explicit
Public Sub GetData()
    Dim ie As New InternetExplorer, t As Date, address As Object, result As Object
    Const MAX_WAIT_SEC As Long = 5
    With ie
        .Visible = True
        .Navigate2 "https://azredistricting.org/districtlocator/"

        While .Busy Or .readyState < 4: DoEvents: Wend
        t = Timer
        Do
            On Error Resume Next
            Set address = .document.querySelector("#txtAddress")
            On Error GoTo 0
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While address Is Nothing

        If Not address Is Nothing Then
            .document.querySelector("#txtAddress").Value = "1100 W. Washington St Phoenix, Arizona 85007"
            .document.querySelector("[value=Find]").Click

            Do
                Set result = .document.querySelector("#districts")
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop While result.innerText = vbNullString

            Debug.Print result.innerText
        End If
        .Quit
    End With
End Sub

XMLHTTP

Я приведу это в порядок, но стоит отметить, что если вы используете lat и long для адресов (например, я получаю их с помощью вызова opencagedata API и конкатенируйте их в запросе xhr post, вы можете получить ответ json от обоих, с помощью которого вы можете проанализировать jsonparser, такой как jsonconverter.bas . После добавления .bas в ваш проект вам нужно перейти на VBE> Инструменты> Ссылки и добавьте ссылку на Microsoft Scripting Runtime.

Option Explicit

Public Sub test()
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    Dim apiKey As String, address As String, url As String, json As Object
    apiKey = "yourAPIkey"
    address = "13 E Tanglewood Trl, Phoenix, AZ 85085" '1100 W. Washington St Phoenix, Arizona 85007
    url = Application.WorksheetFunction.EncodeURL(address)
    url = "https://api.opencagedata.com/geocode/v1/json?q=" & address & "&key=" & apiKey & "&pretty=1"

    With http
        .Open "GET", url, False
        .send
        Set json = JsonConverter.ParseJson(.responseText)

    Dim dict As Object, lat As String, lng As String
    Set dict = json("results")(1)("geometry")
    lat = dict("lat")
    lng = dict("lng")
       .Open "POST", "https://azredistricting.org/districtlocator/SpatialFunctions.asmx/GetBothDistricts", False
       .setRequestHeader "Content-Type", "application/json; charset=UTF-8"
       .send "{""dblLat"":" & lat & ",""dblLon"":" & lng & ",""locType"":""ROOFTOP""}"

        Set json = JsonConverter.ParseJson(.responseText)
        Debug.Print Split(Replace$(Replace$(json("d"), "<b><big><big>", vbNullString), "</big></big></b>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;", Chr$(32)), "<")(0)
     End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...