解析未完全加载VBA的网站 [英] Parsing website that doesnt fully load VBA

问题描述

尝试通过简单的Web解析，我的问题是直到向下滚动页面才能完全加载. Google搜索想出了可能使用硒的方法，但是由于我不知道如何使用硒，我想我会在这里问到

Trying my hand at a simple web parse, my problem is the page doesnt fully load until you scroll down. Google search has come up with possibly using selenium but as I have no idea how to use it I figured I would ask here

代码即时通讯使用

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

推荐答案

使用基本的硒和使用 @Hubisan 的技术来处理延迟加载页面并滚动直到所有内容加载完毕:

Using selenium basic and using the technique by @Hubisan to handle lazy loading pages and scrolling until everything loaded:

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

一些示例输出:

这篇关于解析未完全加载VBA的网站的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！