加载所有动态加载的 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
我有用于加载 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