填充 html 自动搜索框并获取结果

Question

我正在尝试填写网页上的搜索框，当它被填写时，它会自动搜索结果。该网站是https://pcpartpicker.com/products/motherboard/。如果您去那里输入主板名称的主板制造商，您会看到它如何开始缩小可能的选择范围。我有将填充搜索框的代码，但没有任何反应。

Sub GetMotherboards()
    Dim ie                      As InternetExplorer
    Set ie = New InternetExplorer

    Dim doc                     As HTMLDocument
    Dim objText                 As DataObject
    Dim objArticleContents      As Object
    Dim objLinksCollection      As Object
    Dim objToClipBoard          As DataObject
    Dim r As Object
    Dim prodRating              As String
    Dim prodName                As String
    Dim lngNumberOfVideos As Long
    Dim strURL                  As String
    Dim strNewString As String, strStr As String, strTestChar As String
    Dim bFlag As Boolean

    strURL = "https://pcpartpicker.com/products/motherboard/" ' Range("J5").Value
    With ie
        .navigate strURL
        .Visible = True
        Do While .readyState <> 4: DoEvents: Loop
        Application.Wait Now + #12:00:02 AM#

        Set doc = ie.document
    End With
    bFlag = False
    With doc
        Set objArticleContents = .getElementsByClassName("subTitle__form")

        Stop
        Set ele = .getElementsByClassName("subTitle__form")(0)

        Set form = .getElementsByClassName("subTitle__form")(0).getElementsByClassName("form-label xs-inline")(1)

        Set inzputz = ele.getElementsByClassName("text-input")(0)
        Call .getElementsByClassName("text-input")(0).setAttribute("placeholder", "MSI B450 TOMAHAWK") '.setAttribute("part_category_search", "MSI B450 TOMAHAWK")
    End With

End Sub

在这里阅读了一些帖子（我现在找不到）后，我的想法是有/有事件侦听器和函数需要包含在此代码中，但这超出了我的想象。有人可以帮我解决这个问题。

Tim Williams 在这里有一篇帖子（帖子的答案）讨论了这个问题，但现在我找不到了。

Answer 1

您可以避免使用浏览器并执行与返回 json 的页面相同的xhr GET request。您将需要一个 json 解析器来处理响应。

Json 库：

我使用 jsonconverter.bas。从 here 下载原始代码并添加到名为 JsonConverter 的标准模块中。然后您需要转到 VBE > 工具 > 参考 > 添加对 Microsoft Scripting Runtime 的引用。从复制的代码中删除顶部的 Attribute 行。

我展示了一个部分实现，它请求不同的类别和产品，并使用完整和部分字符串搜索。这是一个部分实现，因为我将响应读入 json 对象并打印 json 字符串，但不尝试访问 json 对象中的所有项目。这可以根据您提供的更多细节进行改进。对于演示目的，我访问("result")("data")，它会为您提供价格和名称信息。原始响应 json 的一部分具有 html 作为访问器 ("result")("html") 的值。这有描述信息，例如带有主板项目的插槽/CPU。

Option Explicit

Public Sub ProductSearches()
    Dim xhr As Object, category As String, items()

    Set xhr = CreateObject("MSXML2.XMLHTTP")
    category = "motherboard"
    items = Array("Gigabyte B450M DS3H", "MSI B450 TOMAHAWK", "random string")

    PrintListings items, xhr, category

    category = "memory"
    items = Array("Corsair Vengeance") 'partial search

     PrintListings items, xhr, category

End Sub

Public Function GetListings(ByVal xhr As Object, ByVal category As String, ByVal item As String) As Object
    Dim json As Object
    With xhr
        .Open "GET", "https://pcpartpicker.com/products/" & category & "/fetch/?xslug=&location=&search=" & item, False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        Set json = JsonConverter.ParseJson(.responseText)("result")("data")
        Set GetListings = json
    End With
End Function

Public Sub PrintListings(ByRef items(), ByVal xhr As Object, ByVal category As String)
    'Partially implemented. You need to decide what to do with contents of json object
    Dim json As Object, i As Long
    For i = LBound(items) To UBound(items)
        Set json = GetListings(xhr, category, items(i))
        'Debug.Print Len(JsonConverter.ConvertToJson(json)) ' Len(JsonConverter.ConvertToJson(json)) =2 i.e {} then no results
        Debug.Print JsonConverter.ConvertToJson(json)  'demo purposes only
        'do something with json
    Next
End Sub

---

Json 解析：

阅读关于在 vba here、here 和 here 中使用 JsonConverter 和解析 json。

Answer 2

您需要在将值放入文本框之后执行keyup 事件。

您可以使用execScript 方法完成此操作。

因此，在您加载网页后，为您的输入/文本框创建一个变量。在下面的示例中，它是tb。将 .Value 属性设置为您的搜索文本（我使用“MSI”），然后通过脚本触发 keyup 事件。

Dim tb As HTMLInputElement
Set tb = IE.document.getElementById("part_category_search")
tb.Value = "MSI"
IE.document.parentWindow.execScript "$('#part_category_search').keyup()"

我对 jQuery 不太熟悉，所以这个脚本针对网页上的所有输入。但我已经对其进行了测试，它适用于您的搜索。

如果你想缩短你的，这是我在测试中使用的完整代码：

Dim IE As InternetExplorer
Set IE = New InternetExplorer
IE.Visible = True
IE.navigate "https://pcpartpicker.com/products/motherboard/"
Do While IE.Busy Or IE.readyState < 4
    DoEvents
Loop

Dim tb As HTMLInputElement
Set tb = IE.document.getElementById("part_category_search")
tb.Value = "MSI"
IE.document.parentWindow.execScript "$('#part_category_search').keyup()"