加载所有动态加载 HTMLTable - VBA

Question

我有用于加载 HTMLTable 的代码，但我最近有一个很大的列表，并意识到它只是拉到列表的顶部。当我在浏览器中向下滚动表格时，观察开发控制台的进一步调查显示多个“发布”请求。我正在讨论构建代码（如果可以的话）以尝试找到表中的最后一项，然后再次运行查询，但我想看看我是否可以“正确”解决根本问题而不是破解它。

我怎样才能模拟滚动和监控帖子请求或任何其他建议？

这是一些示例代码，但不幸的是，我不能将链接共享为仅作为 LAN 访问。注意：不需要登录，但如果不使用 IE 对象来生成与请求相关的 cookie（无法通过 CLI 发布），我无法弄清楚如何做到这一点。

 Do Until InStr(1, IEObj.document.getElementById("gbox_tbl").innerHTML, "WAREHOUSE") > 0
   DoEvents
 Loop
 Dim table As MSHTML.HTMLTable, HTMLCollection As IHTMLElementCollection
 Set table = IEObj.document.getElementById("gbox_tbl")
  
 Set ClipBoard = New MSForms.DataObject
 Application.Wait (Now() + TimeValue("00:00:01"))
 ClipBoard.SetText table.outerHTML
 ClipBoard.PutInClipboard
 
 Dim TempWS As Worksheet
 Call WorksheetCreateDelIfExists("TempSheet")
 Set TempWS = Worksheets("TempSheet")
 TempWS.Activate
 Range("A1").Select
 ActiveSheet.Paste
 'Stop
 Dim UsedRng As Range
 Set UsedRng = GetUsedRange(TempWS)
 UsedRng.Copy

 Dim FindSMPDestWS As Worksheet, wss As Worksheet, SearchTerm As String, i As Integer
 i = 0
 SearchTerm = "FindWSR"
 For Each wss In ActiveWorkbook.Worksheets
  If Left(wss.Name, Len(SearchTerm)) = SearchTerm Then
   i = i + 1
  End If
 Next wss
 If i = 0 Then
  Call WorksheetCreate("FindWSR")
 Else
  Call WorksheetCreate("FindWSR(" & i & ")")
 End If
 Set FindSMPDestWS = ActiveSheet
 FindSMPDestWS.Activate
 Range("A1").Select
 FindSMPDestWS.Paste
 If Range("A1") <> "Loading..." Then
  Application.Wait (Now() + TimeValue("00:00:01"))
  ClipBoard.SetText table.outerHTML
  ClipBoard.PutInClipboard
  Range("A1").Select
  FindSMPDestWS.Paste
 End If

Answer 1

更新：我遇到了另一个表，我下面的 Sub 没有正常工作，所以我想再次解决这个问题，以找到更强大的解决方案。 @Qharr 关于术语“延迟加载”网页的提示与他评论中的 URL 一起提供了帮助。以下是我所拥有的，它适用于我测试的两张表，但它们都是同一家公司编写的内部页面，所以 YMMV 但我很高兴一如既往地接受建议/反馈。

代码：

Sub Testing()
 'Scroll Entire HTML Table
 Dim ScrollBarDivInt As Integer, StepLng As Long, ScrollElmIDStr As String, LoadingElmIDStr As String, LoadingTrueCheckStr As String, LoadingFalseCheckStr As String
 ScrollBarDivInt = 0
 StepLng = 1000
 ScrollElmIDStr = "ui-jqgrid-bdiv"
 LoadingElmIDStr = "load_grdDisposition"
 LoadingTrueCheckStr = "block"
 LoadingFalseCheckStr = "none"
 Call Scroll_HTMLTable(ScrollBarDivInt, StepLng, ScrollElmIDStr, LoadingElmIDStr, LoadingTrueCheckStr, LoadingFalseCheckStr)
End Sub

---

Public Sub Scroll_HTMLTable(ByVal ScrollBarDivInt As Integer, ByVal StepLng As Long, ByVal ScrollElmIDStr As String, ByVal LoadingElmIDStr As String, ByVal LoadingTrueCheckStr As String, ByVal LoadingFalseCheckStr As String)
 Dim HLng As Long
 HLng = IEObj.document.getElementsByClassName(ScrollElmIDStr)(ScrollBarDivInt).ScrollHeight
 For i = 1 To HLng Step StepLng
  IEObj.document.getElementsByClassName(ScrollElmIDStr)(ScrollBarDivInt).ScrollTop = i
  Application.Wait (Now() + TimeValue("00:00:1"))
  If InStr(IEObj.document.getElementById(LoadingElmIDStr).outerHTML, LoadingTrueCheckStr) > 0 Then UILoading_Bool = True
  If InStr(IEObj.document.getElementById(LoadingElmIDStr).outerHTML, LoadingFalseCheckStr) > 0 Then UILoading_Bool = False
  Debug.Print "UILoading_Bool = " & UILoading_Bool
  Do While UILoading_Bool = True
   Application.Wait (Now() + TimeValue("00:00:1"))
   If InStr(IEObj.document.getElementById(LoadingElmIDStr).outerHTML, LoadingTrueCheckStr) > 0 Then UILoading_Bool = True
   If InStr(IEObj.document.getElementById(LoadingElmIDStr).outerHTML, LoadingFalseCheckStr) > 0 Then UILoading_Bool = False
  Loop
 Next
End Sub

注意：我可以使用下面的内容直接滚动到底部，但是我的网页真的很懒，除非我在滚动时暂停，否则它不会加载表格的“中间”，因此是“等待”。

IEObj.document.getElementsByClassName(ScrollElmIDStr)(ScrollBarDivInt).ScrollTop = IEObj.document.getElementsByClassName(ScrollElmIDStr)(ScrollBarDivInt).ScrollHeight

结束更新

---

这并不完全干净，但它现在确实有效，不幸的是，在重新设置表格以检查长度之前，我似乎无法找到一种方法来“检查”页面是否已加载。我正在使用“application.wait”，它在我的测试中运行良好，但我稍后会尝试改进循环。我也愿意就更好的方法来解决这个问题提出建议。

Public Sub ScrollTable(table As MSHTML.HTMLTable)
 Dim tcell As Object, tcells As Object, ltablerow As Long, c As Long
  Set tcells = table.getElementsByTagName("tr")
  Do
  c = 0
  ltablerow = tcells.Length
  'Stop
  For Each tcell In tcells
  c = c + 1
   If c > ltablerow - 5 Then
    tcell.Click
    tcell.Focus
    SendKeys "{DOWN}"
    SendKeys "{DOWN}"
   End If
  Next
  Application.Wait (Now() + TimeValue("00:00:05"))
  Set tcells = table.getElementsByTagName("tr")
  Loop Until tcells.Length = ltablerow

End Sub