Question

我是创建VBA代码的新手，我正在慢慢了解它，但是如果没有帮助我无法通过我的项目这一点。我有下面的代码并运行良好，直到我需要继续打开新页面的代码。我不知道如何能够继续代码，计划是能够点击赔率比较选项卡并从该页面提取数据。任何援助将不胜感激。

Sub odd_comparison()


    Dim objIE As InternetExplorer
    Dim ele As Object
    Dim y As Integer

    Set objIE = New InternetExplorer

    objIE.Visible = True


    objIE.navigate "http://www.flashscore.com/basketball/"

    Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

  objIE.document.getElementById("fs").Children(0) _
      .Children(2).Children(2).Children(0).Children(2).Click

End Sub

Answer 1

尝试按照this和this中的说明进行循环，直到网页准备就绪（您知道，将WScript.Sleep替换为DoEvents以获取VBA）。

使用开发者工具检查网页上的目标元素（使用上下文菜单或按 F12 ）。 HTML内容如下：

<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方法：

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")和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

我的网页赔率比较标签内容如下：

它给出了输出：

如何在打开新网页后继续使用VBA代码

1 个答案: