解析未完全加载 VBA 的网站

Question

尝试进行简单的 Web 解析，我的问题是页面在您向下滚动之前无法完全加载。谷歌搜索可能会使用 selenium，但由于我不知道如何使用它，所以我想我会在这里问

我正在使用的代码

Sub gfquote()

Dim oHttp As MSXML2.XMLHTTP
Dim sURL As String
Dim HTMLDoc As HTMLDocument
Dim dequote As String
Dim driver As New Webd
' Create an XMLHTTP object
Set oHttp = New MSXML2.XMLHTTP
    Dim oElement As Object
' get the URL to open
sURL = "https://www.thevinylspectrum.com/siser-heat-transfer-vinyl/siser-easyweed/12in-x-59in-rolls/"

' open socket and get website html
oHttp.Open "GET", sURL, False
oHttp.send
Set HTMLDoc = New HTMLDocument
With HTMLDoc
    ' assign the returned text to a HTML document
    .body.innerHTML = oHttp.responseText
    dastring = oHttp.responseText
    ' parse the result
  UserForm1.TextBox1.Text = dastring


   Set prices = .getElementsByClassName("price product-price")
    For Each oElement In prices
    Sheets("Sheet1").Range("A" & i + 1) = prices(i).innerText
    i = i + 1
Next oElement



End With

'Clean up
Set oHttp = Nothing

End Sub

Answer 1

使用selenium basic 和@Hubisan 的技术来处理延迟加载页面和滚动直到加载所有内容：

Option Explicit
Public Sub GetNamesAndPrices()
    Dim driver As New ChromeDriver, prevlen As Long, curlen As Long
    Dim prices As Object, price As Object, name As Object, names As Object
    Dim timeout As Long, startTime As Double

    timeout = 10                                 ' set the timeout to 10 seconds

    Application.ScreenUpdating = False

    With driver
        .get "https://www.thevinylspectrum.com/siser-heat-transfer-vinyl/siser-easyweed/12in-x-59in-rolls/"
        prevlen = .FindElementsByCss(".price.product-price").Count

        startTime = Timer                        ' set the initial starting time

        Do
            .ExecuteScript ("window.scrollTo(0, document.body.scrollHeight);")
            Set prices = .FindElementsByCss(".price.product-price")
            Set names = .FindElementsByCss(".product-name")
            curlen = prices.Count
            If curlen > prevlen Then
                startTime = Timer
                prevlen = curlen
            End If
        Loop While Round(Timer - startTime, 2) <= timeout

        Dim r As Long
        With ActiveSheet
            For Each name In names
                r = r + 1: .Cells(r, 1) = name.Text
            Next
            r = 0
            For Each price In prices
                r = r + 1: .Cells(r, 2) = price.Text
            Next
        End With
    End With
    Application.ScreenUpdating = True
End Sub

一些示例输出：