Can Excel 2007 import from JSON data in real-time?

[d0rian]

I'm trying to create a file that pulls in real-time golf scores -- the PGA tour site appears to provide data JSON format (which I've never worked with) here: https://statdata.pgatour.com/r/014/leaderboard-v2mini.json

I don't quite know how to parse that wall of text for use in Excel 2007. Later versions appear to have the ability to connect directly to JSON data(?) but I'm not sure if that's simply not possible in Excel 2007.

I could probably download that text data and cobble together some method to paste it raw into a sheet and write functions to parse it into a reader-friendly format...but that wouldn't be a "live" solution that updates itself in real-time. Is that possible?

 

[John_w]

You're correct that Excel 2010+ can import and parse JSON data directly via Power Query. For Excel 2007, you'll need custom VBA code to request the data using XMLhttp and a VBA JSON parser to parse it.

The following code (Extract_Leaderboard_Data) requests the JSON data and extracts the details of the first 20 players from it. You will need a workbook with sheets named "Leaderboard" and "JSON".

First, copy and paste the JSON.bas code from https://github.com/omegastripes/VBA-JSON-parser into a standard module. Delete the first line (Attribute ...), otherwise it won't compile.

Next, put the following code in another standard module.

Public Sub Extract_Leaderboard_Data()

    Dim httpReq As Object
    Dim URL As String
    Dim JSONall As Variant
    Dim parseState As String
    Dim destCell As Range
    Dim i As Long
    Dim player As Variant
    
    With ThisWorkbook.Worksheets("Leaderboard")
        .Cells.Clear
        .Range("A1:F1").Value = Array("Pos", "U/D", "Player", "Total", "Hole", "Round")
        Set destCell = .Range("A2")
    End With
    
    URL = "https://statdata.pgatour.com/r/014/leaderboard-v2mini.json"
    
    Set JSONall = Nothing
    Set httpReq = CreateObject("MSXML2.XMLHTTP")
    With httpReq
        .Open "GET", URL, False
        .Send
        If .Status = 200 Then
            'Debug.Print .responseText
            Parse .responseText, JSONall, parseState
            If parseState = "Error" Then
                MsgBox "Error parsing JSON data"
                Exit Sub
            End If
        End If
    End With
    
    With ThisWorkbook.Worksheets("JSON")
        If IsEmpty(.Range("A1").Value) Then 
            .Cells.Clear
            JSONToCells JSONall, .Range("A1")
        End If
    End With

    destCell.Worksheet.Range("G1").Value = "Data last updated " & Right(JSONall("last_updated"), 8)
    
    For i = 0 To 19
        Set player = JSONall("leaderboard")("players")(i)
        destCell.Offset(i, 0).Value = CvtPos(player("current_position"))
        destCell.Offset(i, 1).Value = CvtPos(player("start_position")) - CvtPos(player("current_position"))
        destCell.Offset(i, 2).Value = player("player_bio")("first_name") & " " & player("player_bio")("last_name")
        destCell.Offset(i, 3).Value = player("total")
        destCell.Offset(i, 4).Value = player("thru")
        destCell.Offset(i, 5).Value = player("today")
    Next
           
End Sub


Private Function CvtPos(ByVal pos As String) As Integer
    'Convert position string (which may be prefixed with "T" for 'tied') to its numeric value
    If Val(pos) = 0 Then
        CvtPos = Mid(pos, 2)
    Else
        CvtPos = pos
    End If
End Function


Private Function JSONToCells(JSONvar As Variant, destCell As Range, Optional ByVal path As String) As Long

    Dim n As Long
    Dim key As Variant
    Dim i As Long
    
    'Output parsed JSON data to Excel cells in a hierarchical layout
    
    n = 0
    
    If varType(JSONvar) = vbObject Then 'Dictionary
        
        For Each key In JSONvar.keys
            'Debug.Print key
            destCell.Offset(n, 0).Value = key
            n = n + JSONToCells(JSONvar.item(key), destCell.Offset(n, 1), path & "(" & key & ")")
        Next
    
    ElseIf varType(JSONvar) >= vbArray Then 'Variant()
                
        For i = 0 To UBound(JSONvar)
            'Debug.Print i
            destCell.Offset(n, 0).Value = i
            n = n + JSONToCells(JSONvar(i), destCell.Offset(n, 1), path & "(" & i & ")")
        Next
        
    Else
        
        'Debug.Print JSONvar
        destCell.Offset(n, 0).Value = JSONvar
        CreateComment destCell.Offset(n, 0), path
        n = n + 1
        
    End If

    JSONToCells = n
    
End Function


Private Sub CreateComment(cell As Range, commentText As String)
        
    With cell
        If .Comment Is Nothing Then .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=commentText
        .Comment.Shape.TextFrame.AutoSize = True
    End With
    
End Sub

Run the Extract_Leaderboard_Data macro to get the latest leaderboard data. You might need to sort it by column A (Position) because the players are extracted in the same order as they appear in the JSON data, and the Position value in column A is obtained from the current_position field. To update the leaderboard in 'real-time' you would have to periodically run the macro or call it with an Application.OnTime timer.

The macro calls the JSONToCells function which outputs the JSON data to the JSON sheet in a hierarchical layout, helping you to understand the structure of the data. Notice that each data value cell has a cell comment showing the 'path' to that data.