解析没有完全加载VBA的网站

时间:2018-06-13 19:33:15

标签: vba parsing

尝试简单的网络解析,我的问题是页面没有完全加载,直到你向下滚动。谷歌搜索已经提出可能使用硒但我不知道如何使用它我想我会问这里

使用

代码
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

1 个答案:

答案 0 :(得分:2)

使用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

一些示例输出:

Example output