麻烦使我的解析器向下滚动

时间:2018-04-06 17:56:56

标签: vba excel-vba scroll web-scraping internet-explorer-11

我在vba中编写了一个脚本来解析网页中的一些信息。事情是在从该网页上抓取任何信息之前我需要让我的刮刀向下滚动几次。这是我被困的地方。我需要滚动的部分是左侧窗口。任何帮助将不胜感激。

Website Link

这是我的尝试:

Sub Make_Scroll()
    Dim HTML As HTMLDocument, post As Object
    Dim Scroll As Object, URL$

    URL = "replace_with_above_link"

    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .navigate URL
        While .Busy = True Or .readyState < 4: DoEvents: Wend
        Set HTML = .document

        Application.Wait Now + TimeValue("00:00:003")

        Set Scroll = HTML.querySelector(".iScrollLoneScrollbar[style*='z-index: 9999;']")
        Scroll.scrollTop = Scroll.scrollHeight
    End With
End Sub

制作卷轴的内容可在以下部分内使用:

<div class="iScrollVerticalScrollbar iScrollLoneScrollbar" style="position: absolute; z-index: 9999; width: 7px; bottom: 2px; top: 2px; right: 1px; overflow: hidden;"><div class="iScrollIndicator" style="box-sizing: border-box; position: absolute; background: rgba(0, 0, 0, 0.5); border: 1px solid rgba(255, 255, 255, 0.9); border-radius: 3px; width: 100%; transition-duration: 0ms; display: block; height: 8px; transform: translate(0px, 26px) translateZ(0px); transition-timing-function: cubic-bezier(0.1, 0.57, 0.1, 1);"></div></div>

1 个答案:

答案 0 :(得分:3)

看一下下面的例子:

Option Explicit

Sub Test()

    ' Add references
    ' Microsoft XML, v6.0
    ' Microsoft HTML Object Library

    Dim sResponse As String
    Dim aResult() As String
    Dim i As Long
    Dim oElement As HTMLDivElement

    With New XMLHTTP
        .Open "POST", "http://catalogo.marmomac.it/ajax/getListEspositori.php", False
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
        .Send "start=0&count=5000"
        sResponse = .ResponseText
    End With
    With New HTMLDocument
        .body.innerHTML = sResponse
        i = 1
        For Each oElement In .getElementsByClassName("elemento")
            ThisWorkbook.Sheets(1).Cells(i, 1) = oElement.innerText
            i = i + 1
        Next
    End With

End Sub

我的输出如下,总共有1669项:

output