单击两个按钮后抓取数据

Question

我试图从这个网页上抓取每个 model 的 href： https://www.aprilia.com/en_EN/index 。
显示 href 数据的 html 只有在点击两个按钮（右上角的一个和左侧的“模型”按钮）后才能看到，一个接一个。

Sub get_info()
  
Dim ie As Object
Dim address, str_chk As String
Dim my_data As Object
Dim oHTML_Element As IHTMLElement
Dim i As Long
  
address = "https://www.aprilia.com/en_EN/index"

Set ie = CreateObject("InternetExplorer.Application")
ie.navigate address 'the one mentioned above
ie.Visible = False
  
Do While ie.Busy Or ie.readyState <> 4
    DoEvents
Loop
  
For Each oHTML_Element In ie.document.getElementsByName("button")
    If oHTML_Element.className = "header__menu-services__nav button button--icon" Then
        oHTML_Element.Click
    End If
Next
  
Application.Wait Now + #12:00:05 AM#

For Each oHTML_Element In ie.document.getElementsByName("Models")
    oHTML_Element.Click
Next

Application.Wait Now + #12:00:05 AM#

'==>
Set my_data = html.getElementsByClassName("card-product card-product--family")

For Each elem In my_data
    For i = 0 To elem.getElementsByTagName("a").Length - 1
        str_chk = elem.getElementsByTagName("a")(i).href
        ws.Cells(9 + j, 7).Value = str_chk
        j = j + 1
    Next i
Next elem

ie.Quit
Set ie = Nothing
End Sub

我有

错误“424”- Object 必需

我在哪里设置my_data 。

我想这意味着我无法点击这两个按钮，因此 html 代码不可用。

***************** 修改后的代码：

Sub get_info22()

Dim address As String
Dim ie, ELE, nodes As Object
Dim i As Long
Dim t As Date
Const MAX_WAIT_SEC As Long = 10
  
address = "https://www.aprilia.com/en_EN/index"

Set ie = CreateObject("InternetExplorer.Application")
ie.navigate address 'the one mentioned above
ie.Visible = False
  
Do While ie.Busy Or ie.readyState <> 4
    DoEvents
Loop

'************** click on first button
t = Timer
Do
    On Error Resume Next
    Set ELE = ie.document.querySelector(".header__menu-services__nav")

    If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While ELE Is Nothing
If Not ELE Is Nothing Then
    ELE.Click
End If

While ie.Busy Or ie.readyState <> 4: DoEvents: Wend
'************** click on second button
Do
    On Error Resume Next
    Set ELE = ie.document.querySelector("li > button")

    If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While ELE Is Nothing

If Not ELE Is Nothing Then
    ELE.Click
End If

While ie.Busy Or ie.readyState <> 4: DoEvents: Wend

'************** get href for each model

Set nodes = ie.document.querySelectorAll(".card-product--family")

ReDim hrefs(nodes.Length - 1)

For i = 0 To nodes.Length - 1
    hrefs(i) = nodes.Item(i).href
    ActiveSheet.Cells(9 + i, 7).Value = hrefs(i)
Next

Answer 1

首先尝试使用更精确的选择器。 对于第一个按钮使用：

ie.document.querySelector(".header__menu-services__nav").click

这通过其类之一来定位元素。 然后暂停一下，例如

While ie.Busy Or ie.ReadyState<>4:DoEvents:Wend

或者，使用显式等待时间或循环直到出现下一个所需元素。

然后使用 类型选择器和子组合器定位下一个元素，因为您希望li元素中的第一个子button ：

ie.document.querySelector("li > button").click

那你还需要再等一等。

最后，您可以使用目标元素中的单个 class 和链接，提取href属性并存储在数组中（例如）

Dim nodes As Object, hrefs(), i As Long

Set nodes = ie.Document.querySelectorAll(".card-product")

ReDim hrefs(nodes.Length - 1)

For i = 0 To nodes.Length - 1
    hrefs(i) = nodes.Item(i).href
Next

---

编辑：

似乎页面使用 ajax 来检索列表，这使得这更容易。 我显示版本。 第一个是点击两次按钮后我只抓取你描述的那些链接； 第二个，我也在这里获取 model 子类型链接。

在两者中，我都模仿页面为获取该信息而提出的请求。 首先，我用 json 解析器解析返回的 json 并提取 model 链接。 第二个，我正则表达式出所有 href 信息即。 所有子模型。

---

Json 图书馆：

我使用 jsonconverter.bas。 从这里下载原始代码并添加到名为 JsonConverter 的标准模块中。 然后您需要 go VBE > Tools > References > Add reference to Microsoft Scripting Runtime。 从复制的代码中删除顶部属性行。

1)

Option Explicit

Public Sub ScrapeModelLinks1()
    
    Dim data As Object, links() As Variant, s As String
    
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.aprilia.com/en_EN/aprilia/en/index?ajax=true", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        s = .responseText
    End With

    Set data = JsonConverter.ParseJson(s)("pageData")("main")("component-06")("items")
    
    ReDim links(data.Count)
    Dim item As Long, base As String
    
    base = "https://www.aprilia.com"

    For item = 1 To data.Count
        links(item) = base & data(item)("href")
    Next
    
    Stop
    
End Sub

---

Public Sub ScrapeModelLinks2()
    'grab all href which will include model subtypes
    Dim s As String
    
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.aprilia.com/en_EN/aprilia/en/index?ajax=true", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        s = .responseText
    End With
    
    Dim re As Object, matches As Object, links() As Variant
    
    Set re = CreateObject("VBScript.RegExp")

    re.Pattern = """href"":""(.*?)"""
    re.Global = True
    Set matches = re.Execute(s)
    
    ReDim links(matches.Count - 1)
    Dim item As Long, base As String
    
    base = "https://www.aprilia.com"
 
    For item = 0 To matches.Count - 1
        links(item) = base & matches(item).submatches(0)
    Next
    
    Stop
    
End Sub

---

正则解释：