how to continue VBA code after opening a new web page

Question

I\'m new to creating VBA code and I\'m slowly getting a basic understanding of it, however I\'m unable to pass this point of my project without assistance. I have the code b

Answer 1

Try to make loop until the webpage ready as described in this and this answers (you know, replace WScript.Sleep with DoEvents for 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>

As you can see there is onclick attribute, and actually you can try to execute jscript code from it instead of invoking click method:

objIE.document.parentWindow.execScript "setNavigationCategory(4);pgenerate(true, 0,false,false,2); e_t.track_click('iframe-bookmark-click', 'odds');", "javascript"

Going further you can find the following spinner element, which appears for the short time while data is being loaded after the tab clicked:

<div id="preload" class="preload pvisit" style="display: none;"><span>Loading ...</span></div>

So you can detect when the data loading is completed by checking the visibility state:

Do Until objIE.document.getElementById("preload").style.display = "none"
    DoEvents
Loop

The next step is extracting the data you need. You can get all tables from central block: .document.getElementById("fs").getElementsByTagName("table"), loop through tables and get all rows oTable.getElementsByTagName("tr"), and finally get all cells .getElementsByTagName("td") and innerText.

The below example shows how to extract all table data from the webpage odds comparison tab to Excel worksheet:

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

Webpage odds comparison tab content for me is as follows:

It gives the output: