加载所有动态加载的 HTMLTable - VBA

Load all of Dynamically Loading HTMLTable - VBA

我有用于加载 HTMLTable 的代码,但我最近有一个很大的列表并且意识到它只是拉到列表的顶部。当我在浏览器中向下滚动 table 时,观察开发控制台的进一步调查显示多个“post”请求。我正在讨论构建代码(如果我能的话)尝试找到 table 中的最后一项,然后再次 运行 查询,但我想看看我是否可以解决根本问题“正确地”与绕过它进行黑客攻击。

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

这里有一些示例代码,但不幸的是我不能共享 link 作为它的 LAN 访问权限。注意:不需要登录,但如果不使用 IE 对象生成与请求一起出现的 cookie,我无法弄清楚如何做到这一点(无法通过 CLI post)。

 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

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

代码:

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

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

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

结束更新


这不是很干净,但它现在确实有效,不幸的是,我似乎无法找到一种方法来“检查”页面是否已加载,然后重新设置 table 进行检查长度。我正在使用“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