Web Scraping - VBA

Question

I am trying to scrape data from a website without any luck. i manage to navigate through Elements but I haven't managed to get the information from the last Elements. Below is my code, any help would be appreciated.

Option Explicit

Sub Download_Historical_Data()
    
    Dim IE As InternetExplorer, doc As HTMLDocument
    Dim All_Matches, Match
    Dim All_Champions, Champion
    
    'Open Browser and download data
    Set IE = New InternetExplorer

    With IE
        .Visible = True
        .Navigate ("https://www.scorespro.com/soccer/results/")

        While .Busy Or .readyState < 4: DoEvents: Wend

        Set doc = .document

    End With

    Set All_Champions = doc.getElementById("matches-data").getElementsByClassName("compgrp")
        
        For Each Champion In All_Champions
            
            Set All_Matches = Champion.getElementsByTagName("table")
            
            For Each Match In All_Matches
            
                If Left(Match.className, 12) = "blocks gteam" Then
                    With Match
                        'All the info
                    End With
                        
                End If
                
            Next Match
            
        Next Champion

    IE.Quit
    Set IE = Nothing
               
End Sub

Sample on 9/8/19:

Sample on 7/8/19:

Output:

The reason i have use as sample 2 different days is because there is a game with penalties and i want to include this as well.

Answer 1

You don't need to automate a browser. If you inspect the network traffic when selecting a date you will see an XHR request for the info. You can use those details (in fact I shorten to just the required url params) to retrieve the page content.

The info is contained in table tag elements. The champion is in tables with class name blockBar, otherwise the info is for the row info as seen on page. In order to leverage querySelector (which is a method of HTMLDocument) to select the sub table level elements, by class name, for individual tables, I stick the individual table html into a surrogate html document variable; I then have access to querySelector again and so can write nice flexible/descriptive css selectors to match on elements.

The columns in your output all have nice descriptive class names in the XHR response, so you can use those to determine which column to write to. As score info may risk losing formatting on output I use a Select Case statement, to test for those css selectors, and append a single quote to preserve formatting on output.

I choose, for efficiency, to store all results in an array and write out in one go.

Option Explicit
Public Sub GetMatchInfo()
    Dim headers(), results(), r As Long, c As Long, ws As Worksheet, i As Long
    Dim champion As String, html As HTMLDocument, html2 As HTMLDocument, cssSelectors(), j As Long

    Set html = New HTMLDocument
    Set html2 = New HTMLDocument
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    headers = Array("Date", "Time", "Status", "Champion", "Home Team", "Full Time Score", "Away Team", "Half Time", "Penalties Score")
    cssSelectors = Array(".kick_t_dt", ".kick_t_ko", ".status", "champion", ".home", ".score_link", ".away", ".halftime", ".after_pen")

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.scorespro.com/soccer/ajax-calendar.php?mode=results&date=2019-08-07", False
        .send
        html.body.innerHTML = .responseText
    End With

    Dim tables As Object, selector As String

    Set tables = html.querySelectorAll("table")

    ReDim results(1 To tables.Length, 1 To UBound(headers) + 1)

    For i = 0 To tables.Length - 1
        If tables.item(i).className = "blockBar" Then
            champion = tables.item(i).innerText
        Else
            r = r + 1
            html2.body.innerHTML = tables.item(i).outerHTML
            On Error Resume Next
            For j = LBound(cssSelectors) To UBound(cssSelectors)
                selector = cssSelectors(j)
                Select Case selector
                Case ".score_link", ".halftime", ".after_pen"
                    results(r, j + 1) = "'" & html2.querySelector(cssSelectors(j)).innerText
                Case "champion"
                    results(r, j + 1) = champion
                Case Else
                    results(r, j + 1) = html2.querySelector(cssSelectors(j)).innerText
                End Select
            Next
            On Error GoTo 0
        End If
    Next
    ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
    ws.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End Sub

---

Example sample output:

---

Using IE

Option Explicit
Public Sub GetMatchInfo()
    Dim headers(), results(), r As Long, c As Long, ws As Worksheet, i As Long
    Dim champion As String, html As HTMLDocument, html2 As HTMLDocument, cssSelectors(), j As Long

    Set html = New HTMLDocument
    Set html2 = New HTMLDocument
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    headers = Array("Date", "Time", "Status", "Champion", "Home Team", "Full Time Score", "Away Team", "Half Time", "Penalties Score")
    cssSelectors = Array(".kick_t_dt", ".kick_t_ko", ".status", "champion", ".home", ".score_link", ".away", ".halftime", ".after_pen")

    With CreateObject("InternetExplorer.Application")
        .Navigate2 "https://www.scorespro.com/soccer/results/"
        While .Busy Or .readyState <> 4: DoEvents: Wend
        Application.Wait Now + TimeSerial(0, 0, 2)
        html.body.innerHTML = .document.body.innerHTML
        .Quit
    End With

    Dim tables As Object, selector As String

    Set tables = html.querySelectorAll("table")

    ReDim results(1 To tables.Length, 1 To UBound(headers) + 1)

    For i = 0 To tables.Length - 1
        If tables.item(i).className = "blockBar" Then
            champion = tables.item(i).innerText
        Else
            r = r + 1
            html2.body.innerHTML = tables.item(i).outerHTML
            On Error Resume Next
            For j = LBound(cssSelectors) To UBound(cssSelectors)
                selector = cssSelectors(j)
                Select Case selector
                Case ".score_link", ".halftime", ".after_pen"
                    results(r, j + 1) = "'" & html2.querySelector(cssSelectors(j)).innerText
                Case "champion"
                    results(r, j + 1) = champion
                Case Else
                    results(r, j + 1) = html2.querySelector(cssSelectors(j)).innerText
                End Select
            Next
            On Error GoTo 0
        End If
    Next
     ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
    ws.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End Sub

Answer 2

I wrote this in WSL (web scraping language) but basically you can edit the json to add any other fields (assuming all the football games). Once you got all the data, then you can either have it emailed to you or your web server.

GOTO www.scorespro.com/soccer/results/ >> 
EXTRACT {'time': '.kick_t', 'status':'.status',
         'home':'.home.uc', 'score':'.score', 'away':'.away', 'match':'a'} IN table tr

Explanation: it goes to that score page, and then pulls time, status, home, score, away fields for each table row via table tr and finally the match field which will come from the header bar table row. It will look like {'time':undefined, ...., 'match':'Armenia: Premier League'} along with other table row game schedules like {'time':'2019/8/21' ,..., 'match':undefined}. Just merge the JSON objects afterwards.