无法让我的脚本继续使用IE单击“加载更多”按钮

Question

我已经使用IE在vba中创建了一个脚本，以不断单击Load more hits位于网页底部的按钮，直到没有剩下这样的按钮为止。

这是我的脚本填充该按钮的方式：在网站的登录页面中，有一个名为的下拉列表Type。脚本可以单击Type以展开，dropdown然后单击corporate bond选项中的某个复选框。最后，它单击apply按钮以填充数据。但是，该load more hits按钮现在可以在底部看到。

我的脚本几乎可以按照我上面描述的那样执行几乎所有步骤。我唯一要解决的问题是，单击该按钮3/4次后，脚本似乎卡住了。

我如何纠正我的脚本，以继续单击该Load more hits按钮，直到没有剩余的按钮为止？

网站连结

到目前为止，我已经尝试过：

Sub ExhaustLoadMore()
    Dim IE As New InternetExplorer, I As Long
    Dim Html As HTMLDocument, post As Object, elem As Object
    Dim CheckBox As Object, btnSelect As Object

    With IE
        .Visible = True
        .navigate "https://www.boerse-stuttgart.de/en/tools/product-search/bonds"
        While .Busy Or .readyState < 4: DoEvents: Wend
        Set Html = .document

        Do: Loop Until Html.querySelectorAll(".bsg-loader-ring__item").Length = 0

        Html.querySelector("#bsg-filters-btn-bgs-filter-3").Click
        Do: Set CheckBox = Html.querySelector("#bsg-checkbox-3053"): DoEvents: Loop While CheckBox Is Nothing
        CheckBox.Click

        Set btnSelect = Html.querySelector("#bsg-filters-menu-bgs-filter-3 .bsg-btn__label")
        Do: Loop While btnSelect.innerText = "Close"
        btnSelect.Click

        Do: Loop Until Html.querySelectorAll(".bsg-loader-ring__item").Length = 0
        Do: Set elem = Html.querySelector(".bsg-table__tr td"): DoEvents: Loop While elem Is Nothing

        Do
            Set post = Html.querySelector(".bsg-searchlist__load-more button.bsg-btn--juna")
            If Not post Is Nothing Then
                post.ScrollIntoView
                post.Click
                Application.Wait Now + TimeValue("00:00:05")
            Else: Exit Do
            End If
        Loop
    End With
End Sub

我尝试过硒，但似乎慢得多。但是，即使在其中没有硬编码等待的情况下，经过很长的等待时间之后，它仍会单击“加载更多”按钮。在硒的情况下：我希望有任何可能有助于减少执行时间的解决方案。

Sub ExhaustLoadMore()
    Const Url$ = "https://www.boerse-stuttgart.de/en/tools/product-search/bonds"
    Dim driver As New ChromeDriver, elem As Object, post As Object

    With driver
        .get Url
        Do: Loop Until .FindElementsByCss(".bsg-loader-ring__item").count = 0
        .FindElementByCss("#bsg-filters-btn-bgs-filter-3", timeOut:=10000).Click
        .FindElementByXPath("//label[contains(.,'Corporate Bond')]", timeOut:=10000).Click
        .FindElementByXPath("//*[@id='bsg-filters-menu-bgs-filter-3']//button", timeOut:=10000).Click
        Do: Loop Until .FindElementsByCss(".bsg-loader-ring__item").count = 0
        Set elem = .FindElementByCss(".bsg-table__tr td", timeOut:=10000)
        Do
            Set post = .FindElementByCss(".bsg-searchlist__load-more button.bsg-btn--juna", timeOut:=10000)
            If Not post Is Nothing Then
                post.ScrollIntoView
                .ExecuteScript "arguments[0].click();", post
                Do: Loop Until .FindElementsByCss("p.bsg-searchlist__info--load-more").count = 0
            Else: Exit Do
            End If
        Loop
        Stop
    End With
End Sub