使用Excel VBA使用搜索框，触发click事件并检索结果？

Question

在搜索了我可以找到的关于该主题的每个主题之后，一次又一次地遇到错误，我来这里是希望有人能为我提供帮助。

我正在尝试利用该网站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代码是

<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键即可。 任何帮助，将不胜感激。

Answer 1

IE浏览器：

您需要添加一些等待条件，以便有时间正确加载页面并显示响应文本

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脚本运行时的参考。

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