gpt4 book ai didi

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

转载 作者:行者123 更新时间:2023-12-04 21:29:25 25 4
gpt4 key购买 nike

我正在尝试填写网页上的搜索框,当它被填写时,它会自动搜索结果。网址是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

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

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

最佳答案

您可以避免浏览器的费用并执行相同的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 , herehere .

关于html - 填充 html 自动搜索框并获取结果,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/58178463/

25 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com