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

Question

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

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

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

蒂姆威廉姆斯在这里有一个帖子(帖子的答案)讨论了这个但现在我找不到它。

Answer 1

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

json库:

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

我展示了一个部分实现，它请求不同的类别和产品，并使用完整和部分字符串搜索。这是一个部分实现，因为我将响应读入 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解析:

阅读有关使用 的信息json转换器并在 vba here 中解析 json , here和 here .