Заполнение поля авто поиска 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

После прочтения некоторых постов здесь (которые я сейчас не могу найти) я думаю, что есть / есть слушатели событий и функции, которые необходимо включить в этот код, но это у меня над головой. Может кто-нибудь, пожалуйста, помогите мне понять это.

У Тима Уильямса есть пост здесь (ответ на пост), в котором обсуждалось это, но сейчас я не могу его найти.

Answer 1

Вы можете избежать расходов браузера и выполнить тот же xhr GET-запрос на странице, которая возвращает json. Вам понадобится парсер json для обработки ответа.

Библиотека Json:

Я использую jsonconverter.bas. Загрузите необработанный код из здесь и добавьте в стандартный модуль JsonConverter . Затем вам нужно перейти VBE> Инструменты> Ссылки> Добавить ссылку в Microsoft Scripting Runtime. Удалите верхнюю строку атрибута из скопированного кода.

Я показываю частичную реализацию, которая выполняет запросы для различных категорий и продуктов и использует как полный, так и частичный поиск строк. Это частичная реализация, в которой я читаю ответы в объекты json, а также печатаю строки json, но не пытаюсь получить доступ ко всем элементам внутри объекта json. Это может быть уточнено более подробно от вас. Для демонстрационных целей я получаю доступ к ("result")("data"), который дает вам информацию о цене и названии. Часть исходного ответа json имеет html в качестве значения для средства доступа ("result")("html"). Это описание информации, например, сокет / процессор с элементами материнской платы.

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:

Подробнее об использовании JsonConverter и разбореJSON в VBA здесь , здесь и здесь .

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()"