Load all of Dynamically Loading HTMLTable - VBA

user_5079799 0
Viewed 190

I have code that works to load a HTMLTable, but I recently had a large list and realized it was only pulling the top of the list. Further investigation watching dev console shows multiple "post" requests as I scroll down the table in the browser. I'm debating building code (if I even can) to try and find the last item in the table, and then run the query again, but I wanted to see if I could tackle the root problem "correctly" vs hacking around it.

How can I perhaps simulate scrolling and monitor post requests or any other suggestions?

Here is some sample code, but I can't unfortunatley share the link as its LAN access only. Note: No login in required, but I couldn't figure out how to do it without using an IE Object to generate the cookie that goes along w/ the request (couldn't post via 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
html-table internet-explorer vba excel
1 Answers

Update: I ran into another table and my below Sub didn't work correctly so I wanted to tackle this problem again to find a more robust solution. @Qharr tip regarding the term "Lazy Loading" webpage helped along with the URL's in his comment. The below is what I have and it worked on the two tables I tested, but they are both internal pages written by the same company, so YMMV but I'm happy to take suggestions/feedback as always.

Code:

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

Note: I was able to scroll directly to the bottom with the below, but my Webpage was really Lazy, it didn't load the "middle" of the table unless I paused as I scrolled, hence the "wait".

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

End Update

This is not exactly clean, but it does work for now, unfortunately, I can't seem to find a way to "check" that the page has loaded before re-setting the table to check the length. I'm using "application.wait" which worked fine in my testing, but I'll try to improve the loop later. I'm also up for suggestions still on better ways to tackle this.

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