无法让我的解析器向下滚动 [英] Trouble making my parser scroll downward

问题描述

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

I've written a script in vba to parse some information from a webpage. The thing is before scraping any information from that webpage I need to make my scraper scroll downward for few times. Here is where I'm stuck. The portion I need to make scroll is the left sided window. Any help would be greatly appreciated.

Website Link

Here is my try:

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

The content for making scroll may be available within the below portion:

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

解决方案

Take a look at the below example:

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

The output for me as follows, there are 1669 items total:

这篇关于无法让我的解析器向下滚动的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！