尝试进行循环,直到网页准备好,如中所述this and this答案(你知道,替换WScript.Sleep
with DoEvents
对于 VBA)。
Inspect the target element on the webpage with Developer Tools (using context menu or pressing F12). HTML content is as follows:
<a href="#" onclick="setNavigationCategory(4);pgenerate(true, 0,false,false,2); e_t.track_click('iframe-bookmark-click', 'odds'); return false;">bwin.fr Odds</a>
正如你所看到的onclick
属性,实际上你可以尝试从中执行 jscript 代码而不是调用click
method:
objIE.document.parentWindow.execScript "setNavigationCategory(4);pgenerate(true, 0,false,false,2); e_t.track_click('iframe-bookmark-click', 'odds');", "javascript"
更进一步,您可以找到以下微调器元素,该元素在单击选项卡后加载数据时会短暂出现:
<div id="preload" class="preload pvisit" style="display: none;"><span>Loading ...</span></div>
因此,您可以通过检查可见性状态来检测数据加载何时完成:
Do Until objIE.document.getElementById("preload").style.display = "none"
DoEvents
Loop
下一步是提取您需要的数据。您可以从中央块获取所有表:.document.getElementById("fs").getElementsByTagName("table")
,循环遍历表并获取所有行oTable.getElementsByTagName("tr")
,最后得到所有单元格.getElementsByTagName("td")
and innerText
.
以下示例显示如何将网页赔率比较选项卡中的所有表格数据提取到 Excel 工作表:
Option Explicit
Sub Test_Get_Data_www_flashscore_com()
Dim aData()
' clear sheet
Sheets(1).Cells.Delete
' retrieve content from web site, put into 2d array
aData = GetData()
' output array to sheet
Output Sheets(1).Cells(1, 1), aData
MsgBox "Completed"
End Sub
Function GetData()
Dim oIE As Object
Dim cTables As Object
Dim oTable As Object
Dim cRows As Object
Dim oRow As Object
Dim aItems()
Dim aRows()
Dim cCells As Object
Dim i As Long
Dim j As Long
Set oIE = CreateObject("InternetExplorer.Application")
With oIE
' navigate to target webpage
.Visible = True
.navigate "http://www.flashscore.com/basketball/"
' wait until webpage ready
Do While .Busy Or Not .readyState = 4: DoEvents: Loop
Do Until .document.readyState = "complete": DoEvents: Loop
Do While TypeName(.document.getElementById("fscon")) = "Null": DoEvents: Loop
' switch to odds tab
.document.parentWindow.execScript _
"setNavigationCategory(4);pgenerate(true, 0,false,false,2); e_t.track_click('iframe-bookmark-click', 'odds');", "javascript"
Do Until .document.getElementById("preload").Style.display = "none": DoEvents: Loop
' get all table nodes
Set cTables = .document.getElementById("fs").getElementsByTagName("table")
' put all rows into dictionary to compute total rows count
With CreateObject("Scripting.Dictionary")
' process all tables
For Each oTable In cTables
' get all row nodes within table
Set cRows = oTable.getElementsByTagName("tr")
' process all rows
For Each oRow In cRows
' put each row into dictionary
Set .Item(.Count) = oRow
Next
Next
' retrieve array from dictionary
aItems = .Items()
End With
' redim 1st dimension equal total rows count
ReDim aRows(1 To UBound(aItems) + 1, 1 To 1)
' process all rows
For i = 1 To UBound(aItems) + 1
Set oRow = aItems(i - 1)
' get all cell nodes within row
Set cCells = aItems(i - 1).getElementsByTagName("td")
' process all cells
For j = 1 To cCells.Length
' enlarge 2nd dimension if necessary
If UBound(aRows, 2) < j Then ReDim Preserve aRows(1 To UBound(aItems) + 1, 1 To j)
' put cell innertext into array
aRows(i, j) = Trim(cCells(j - 1).innerText)
DoEvents
Next
Next
.Quit
End With
' return populated array
GetData = aRows
End Function
Sub Output(objDstRng As Range, arrCells As Variant)
With objDstRng
.Parent.Select
With .Resize( _
UBound(arrCells, 1) - LBound(arrCells, 1) + 1, _
UBound(arrCells, 2) - LBound(arrCells, 2) + 1)
.NumberFormat = "@"
.Value = arrCells
.Columns.AutoFit
End With
End With
End Sub
我的网页赔率比较选项卡内容如下:
它给出输出: