无法摆脱脚本中的硬编码延迟答案

【问题标题】：Unable to shake off hardcoded delay from my script无法摆脱脚本中的硬编码延迟
【发布时间】：2018-05-18 21:07:14
【问题描述】：

我在 vba 中结合 selenium 编写了一个脚本来解析网页中所有可用的公司名称。该网页已启用延迟加载方法，因此每个滚动中只有 20 个链接可见。如果我滚动 2 次，则可见链接数为 40，依此类推。该网页中有 1000 个链接可用。我下面的脚本可以到达该页面的底部，处理所有滚动并获取该网页中所有可用的名称。

但是，每次滚动后，该网页需要等待一段时间才能更新内容。这是我使用hardcoded delay的地方，但是硬编码的过程非常不一致，有时它会使浏览器在整个操作完成之前退出。

如何修改这部分 .Wait 6000 以使其成为 Explicit Wait 而不是 Hardcoded Wait。

这是我目前写的：

Sub Getlinks()
    Dim driver As New ChromeDriver, prevlen&, curlen&
    Dim posts As Object, post As Object

    With driver
        .get "http://fortune.com/fortune500/list/"
        prevlen = .FindElementsByClass("company-title").Count

        Do
            prevlen = curlen
            .ExecuteScript ("window.scrollTo(0, document.body.scrollHeight);")

            .Wait 6000  ''I like to kick out this hardcoded delay and use explicit wait in place

            Set posts = .FindElementsByClass("company-title")
            curlen = posts.Count
            If prevlen = curlen Then Exit Do
        Loop

        For Each post In posts
            R = R + 1: Cells(R, 1) = post.Text
        Next post
    End With
End Sub

【问题讨论】：

你知道浏览器在加载这些数据时是否变得“忙”吗？根据网站用于获取此数据的方法，您可能可以使用：Do While IeApp.busy Application.Wait DateAdd("s", 5, Now) Loop，没关系，我没注意你正在使用 Chrome。不是 IE。
我在使用 IE 玩同样的游戏时确实尝试了您的建议，但这根本不起作用。一两次滚动后，弓箭手非常顺利地退出。顺便感谢您的建议@Ricardo A。
它是否显示任何类型的装载机或等待符号？如果是这样，您应该等待存在然后消失
感谢@Tarun Lalwani 的提示。我也尝试过这个角度，但无法成功。每个卷轴后都有一个旋转符号可见。一旦新项目加载，该符号就会变得不可见。该符号在 F500-spinner 类中。
我会在 chrome 和 int 网络选项卡中加载一个慢速网络模拟配置文件。这将使您有足够的时间查看和获取微调器标识，然后您应该需要检查其可见性和不可见性

标签： vba excel selenium web-scraping selenium-chromedriver

【解决方案1】：

这是一种完全不同的方法，它不需要使用浏览器，而是提交一系列网络请求。使用这种方法，无需担心等待页面加载。

通常，对于延迟加载页面，它会在您滚动时提交一个新请求来加载页面数据。如果您监控网络流量，您可以发现发出的请求并模拟这些请求，我在下面做了。

结果应该是公司名称列表，无论 Excel 的第一页是什么，都按升序排列。

您需要的东西：

添加对：

的引用

Microsoft 脚本运行时
Microsoft XML v6.0
将 VBA-JSON 代码添加到您的项目中。你可以找到here

编辑

更改了代码以继续从站点中提取数据，直到列表中没有更多项目。感谢@Qharr 指出这一点。

代码

Public Sub SubmitRequest()
    Const baseURL As String = "http://fortune.com/api/v2/list/2358051/expand/item/ranking/asc/"

    Dim Url            As String
    Dim startingNumber As Long
    Dim j              As Long
    Dim getRequest     As MSXML2.XMLHTTP60
    Dim Json           As Object
    Dim Companies      As Object
    Dim Company        As Variant
    Dim CompanyArray   As Variant

    'Create an array to hold each company
    ReDim CompanyArray(0 To 50000)
    'Create a new XMLHTTP object so we can place a get request
    Set getRequest = New MSXML2.XMLHTTP60

    'The api seems to only support returning 100 records at a time
    'So do in batches of 100
    Do
        'Build the url, the format is something like
        '0/100, where 0 is the starting position, and 100 is the ending position
        Url = baseURL & startingNumber & "/" & startingNumber + 100

        With getRequest
            .Open "GET", Url
            .send

            'The response is a JSON object, for this code to work -
            'You'll need this code https://github.com/VBA-tools/VBA-JSON
            'What is returned is a dictionary
            Set Json = JsonConverter.ParseJson(.responseText)
            Set Companies = Json("list-items")

            'Keep checking in batches of 100 until there are no more
            If Companies.Count = 0 Then Exit Do

            'Iterate the dictionary and return the title (which is the name)
            For Each Company In Companies
                CompanyArray(j) = Company("title")
                j = j + 1
            Next

        End With
        startingNumber = startingNumber + 100
   Loop

    ReDim Preserve CompanyArray(j - 1)

    'Dump the data to the first sheet
    ThisWorkbook.Sheets(1).Range("A1:A" & j) = WorksheetFunction.Transpose(CompanyArray)

End Sub

【讨论】：

有趣的方法。无论如何要确定循环的终点，以便全部加载？我在顶部评论说，这个网站的 1000 似乎是固定的，这也可以从选项 3 排名变化中删除。 +1
更新了代码以继续检查直到没有更多项目
更快、更容易、更可靠、可行、适应性强。 +1

【解决方案2】：

你去吧：

Sub Getlinks()
    Dim driver As New ChromeDriver
    Dim pcount As Long, R as long
    Dim posts As Object, post As Object

    With driver
        .get "http://fortune.com/fortune500/list/"
        Do
            .ExecuteScript ("window.scrollTo(0, document.body.scrollHeight);")
            Set posts = .FindElementsByClass("company-title")
            pcount = posts.Count
        Loop Until pcount = 1000

        For Each post In posts
            R = R + 1: Cells(R, 1) = post.Text
        Next post
    End With
End Sub

或者更好的是，随时打印：

Sub Getlinksasyougo()
    Dim driver As New ChromeDriver
    Dim pcount As Long, R As Long, i As Long
    Dim posts As Object, post As Object


    With driver
        .get "http://fortune.com/fortune500/list/"
        i = 1
        Do
            .ExecuteScript ("window.scrollTo(0, document.body.scrollHeight);")
            Set posts = .FindElementsByClass("company-title")
            pcount = posts.Count
            If i <> pcount Then
                For R = i To pcount - 1
                    Cells(R, 1) = posts(R + 1).Text
                Next R
                i = pcount
            End If
        Loop Until pcount = 1000

    End With
End Sub

【讨论】：

这是迄今为止我能遇到的最好的方法。唯一需要摆脱的是这个pcount = 1000 硬编码部分，因为我可能不知道那里有多少个名字。提供加一。谢谢。
这似乎足够了，因为那是 500 和 1000 但我想你可以用 Split(.FindElementsByTag("option")(3).Value, "rankchange")(1) 刮掉 1000我猜你正在寻找一种更可转移的方法来处理延迟加载页面。

【解决方案3】：

这是一种使用其中一个 cmets 中讨论的“查找微调器元素”方法的方法，它可以帮助您避免指定您希望页面加载的元素数量。微调器的类名实际上会根据它是否可见而改变，这使得在获取页面元素之前等待微调器变得可见 + 再次消失变得非常容易。

这种方法仍然需要一些等待；默认情况下，它会在每次尝试找到微调器后等待 1/10 秒，直到找到微调器或达到某个最大尝试次数。但这比每次等待 5 秒要快得多。

另外，不相关，但不要一次向单元格写入内容，这真的很慢。先将其写入数组+一次写入整个数组会快得多。

Sub getLinks()

    Dim bot As New ChromeDriver
    bot.Get "http://fortune.com/fortune500/list/"

    Dim posts As WebElements
    Dim numPosts As Long
    Dim finishedScrolling As Boolean
    finishedScrolling = False
    Do Until finishedScrolling
        'Set beginning post count and scroll down
        Dim startPosts As Long
        startPosts = numPosts
        bot.ExecuteScript "window.scrollTo(0, document.body.scrollHeight);"

        'Wait for spinner to become visible, then wait for up to 5 seconds for rehide
        Call waitForElements(bot, "div[class^='F500-spinner  ']", 50)
        Call waitForElements(bot, "div[class^='F500-spinner hide']", 50)

        'See if any new posts have loaded
        Set posts = bot.FindElementsByClass("company-title")
        numPosts = posts.Count
        If numPosts = startPosts Then
            finishedScrolling = True
        End If
    Loop

    'Write text to results array
    Dim post As WebElement
    ReDim resultsArr(1 To posts.Count, 1 To 1) As String
    Dim i As Long
    i = 1
    For Each post In posts
        resultsArr(i, 1) = post.Text
        i = i + 1
    Next

    'Write array to sheet
    With ActiveSheet
        .Range(.Cells(1, 1), .Cells(UBound(resultsArr, 1), 1)).Value = resultsArr
    End With

End Sub
Sub waitForElements(bot As WebDriver, css As String, maxAttempts As Long, Optional waitTimeMS As Long = 100)
'Use a CSS selector string to wait for element(s) to appear on a page or to reach max number of attempts
'By default, bot waits 0.1 second after each attempt

    Dim i As Long
    Dim foundElem As Boolean
    foundElem = False
    Do Until foundElem
        i = i + 1
        If bot.FindElementsByCss(css).Count > 0 Then
            foundElem = True
        ElseIf i = maxAttempts Then
            foundElem = True
        Else
            bot.Wait waitTimeMS
        End If
    Loop

End Sub

【讨论】：

【解决方案4】：

定义一个超时（允许经过的指定时间段）以消除硬编码延迟。超时需要硬编码。

此代码与您的原始代码之间的区别是：

循环本身反复运行（每次迭代不等待 6 秒）并检查新内容，直到找到新内容或达到超时。
如果延迟加载花费的时间超过预期，例如在加载数字 21 到 50 时，循环“等待”并尝试在 timeout 中定义的最长时间内获取新内容。
缺点：在加载所有内容的最后一步中，循环所需的秒数与设置的超时时间一样多。

代码：

Sub Getlinks()
    Dim driver As New ChromeDriver, prevlen&, curlen&
    Dim posts As Object, post As Object
    Dim timeout As Integer, startTime As Double

    timeout = 10 ' set the timeout to 10 seconds

    With driver
        .get "http://fortune.com/fortune500/list/"
        prevlen = .FindElementsByClass("company-title").Count

        startTime = Timer ' set the initial starting time

        Do
            .ExecuteScript ("window.scrollTo(0, document.body.scrollHeight);")
            Set posts = .FindElementsByClass("company-title")
            curlen = posts.Count
            If curlen > prevlen Then
                startTime = Timer ' reset start time if new elements found
                prevlen = curlen ' set new prevlen
            End If
        Loop While Round(Timer - startTime, 2) <= timeout ' check if timeout is reached

        For Each post In posts
            R = R + 1: Cells(R, 1) = post.Text
        Next post
    End With
End Sub

【讨论】：

感谢您的高效解决方案@Hubisan。它按我的意愿工作。但是，让我们再等几次，如果有更精致的出现。
我在另一个答案+1中引用了你

【解决方案5】：

我不知道这是否会有所帮助，因为它仍然是一个“硬编码”解决方案，但您可以尝试延迟功能而不是等待功能，看看这是否有助于解决程序退出问题。

Function Delay(Seconds As Single)
    Dim StopTime As Single: StopTime = Timer + Seconds
    Do While Timer < StopTime
        DoEvents
    Loop
End Function

【讨论】：

您应该在脚本中显示它的用法以获得更好的响应。谢谢。

【解决方案6】：

我想你快到了。

虽然我认为您无法避免等待，但解决方法是在您向下滚动并缩短等待时间时多次检查新帖子。

下面的示例是检查新帖子 5 次，每次等待 2 秒，因此在声明页面结束之前总共需要 10 秒。调整这两个参数以适应。

Sub Getlinks()
    Dim driver As New ChromeDriver, prevlen&, curlen&
    Dim posts As Object, post As Object
    ' Counter for number of times when there are NO NEW POSTS
    Dim NoIncreaseCount As Integer
    Const MaxNoIncreaseCount As Integer = 5
    Const WaitTime As Integer = 2000 ' 2 seconds wait time each scroll down

    With driver
        .get "http://fortune.com/fortune500/list/"
        prevlen = .FindElementsByClass("company-title").Count
        NoIncreaseCount = 0
        Do Until NoIncreaseCount = MaxNoIncreaseCount
            .ExecuteScript ("window.scrollTo(0, document.body.scrollHeight);")
            .Wait WaitTime
            Set posts = .FindElementsByClass("company-title")
            curlen = posts.Count
            If prevlen < curlen Then
                ' There are new Posts
                prevlen = curlen
                NoIncreaseCount = 0
            Else
                ' No new Posts
                NoIncreaseCount = NoIncreaseCount + 1
            End If
        Loop

        For Each post In posts
            R = R + 1: Cells(R, 1) = post.Text
        Next post
    End With
End Sub

【讨论】：

每隔 2 秒检查 5 次有什么特别的原因吗？问题是如何摆脱硬编码的延迟。如果页面加载 2.1 秒后会发生什么？该代码将再等待 2 秒，这使其变为 4 秒而不是 2.1 秒。如果页面加载 10.1 秒后会发生什么？这也是一种可能。
没有特别的原因。等待间隔多少次取决于目标网站。您可以将等待时间设置为 1 秒，并根据您的经验增加最大计数。由于您只想获取文本，您可能需要自定义浏览器以禁用带有广告拦截的多媒体加载（图片和视频），甚至只允许脚本在主域上运行（禁用第三方脚本）。