I have an excel workbook for comparing various tests results. The results are organized in a table within the workbook. For each test run, the test script itself will generate one json file containing the results for the according run, e.g.:

{
  "name": "dummy",
  "score1": 100,
  "scoreX": 99.4,
  "TestXY": {
    "scoreXYa": 34.5,
    "scoreXYb": 45.7
  }
}

The excel table which lists all the tests looks like this:

I'm looking for a way to statically import the json files and append the results to the list. The lines of the table should not be connected to the according json file as those might be deleted afterwards.

I have created a PowerQuery to load a single json file and transform it into the appropriate format (the format of the table). Now I want to create a static (non-connected) copy and add it to the existing list. The import workflow is:

1. User clicks 'Import Result'
2. User gets prompted to select one or more json files (via VBA Macro)
3. Json file is parsed via PowerQuery
4. Static version of the data is appended to the list

This is my PowerQuery script:

let
    Source = Json.Document(File.Contents(filename)),
    #"Converted to Table" = Record.ToTable(Source),
    #"Transposed Table" = Table.Transpose(#"Converted to Table"),
    #"Promoted Headers" = Table.PromoteHeaders(#"Transposed Table", [PromoteAllScalars=true]),
    #"Changed Type" = Table.TransformColumnTypes(#"Promoted Headers",{{"name", type text}, {"score1", Int64.Type}, {"scoreX", type number}, {"TestXY", type any}}),
    #"Expanded TestXY" = Table.ExpandRecordColumn(#"Changed Type", "TestXY", {"scoreXYa", "scoreXYb"}, {"TestXY.scoreXYa", "TestXY.scoreXYb"})
in
    #"Expanded TestXY"

I am able to to parse the json file. All I need to do now is to append the data to an existing (static) table. Does anybody know how to achieve this? Is this possible via PowerQuery or do I need VBA for this?

Thanks in advance for your help.

CodePudding user response：

I wrote the following code, relying heavily on this post: How to automate a power query in VBA?

Setup: Put the text of your PowerQuery script in a text file named import_json.txt in the same folder as your workbook. Copy the code below into a general code module

Run the sub procedure named import_data and the code will prompt the user to open a json file (must end with ".json") and import the data, appending it to bottom of the data on the active sheet.

Option Explicit

Sub import_data()
    Dim jsonPaths As Collection
    Dim jsonPath As Variant
    Dim mScript As String
    Dim qry As WorkbookQuery
    Dim qName As String
    Dim jsonSheet As Worksheet
    Dim dataSheet As Worksheet
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set dataSheet = ActiveSheet ' use to append json to activesheet
    'Set dataSheet = worksheets("Sheet1") ' use to append json to a specific sheet
    
    Set jsonPaths = get_file_path("*.json")
    
    ' get out of here if the user cancelled the file dialog
    If jsonPaths Is Nothing Then Exit Sub
    
    
    For Each jsonPath In jsonPaths
        
        ' read in the power query script
        mScript = get_file_as_string(ThisWorkbook.path & "\import_json.txt")
        
        ' adjust the script to find the json file the user chose
        mScript = Replace(mScript, "filename", Chr(34) & jsonPath & Chr(34))
        
        ' set the name of the query
        qName = "test_resutls"
        
        If DoesQueryExist(qName) Then
            ' Deleting the query
            Set qry = ThisWorkbook.Queries(qName)
            qry.Delete
        End If
                   
        ' add the query
        Set qry = ThisWorkbook.Queries.Add(qName, mScript)
        
        ' We add a new worksheet with the same name as the Power Query query
        Set jsonSheet = Sheets.Add
        LoadToWorksheetOnly qry, jsonSheet
        
        'copy data from import sheet to data sheet
        Intersect(jsonSheet.Rows(2), jsonSheet.UsedRange).Copy
        dataSheet.Cells(dataSheet.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            
        'remove the import sheet
        jsonSheet.Delete
    Next

End Sub

Function get_file_path(Optional filter As String) As Collection
  ' allows the user to choose a file
  Dim col As Collection
  Dim fd As Office.FileDialog
  Dim x As Long
  Set fd = Application.FileDialog(msoFileDialogFilePicker)
  If filter > "" Then
    fd.Filters.Clear
    fd.Filters.Add "JSON files", filter
 End If
  
  fd.Show
  If fd.SelectedItems.Count = 0 Then Exit Function
  Set col = New Collection
  For x = 1 To fd.SelectedItems.Count
    col.Add fd.SelectedItems(x)
  Next
  Set get_file_path = col
End Function

Function get_file_as_string(path As String) As String
  'opens a text file and returns contents as a string
  Dim ff As Long
  ff = FreeFile
  Open path For Input As ff
    get_file_as_string = Input(LOF(ff), ff)
  Close ff
End Function


Function DoesQueryExist(ByVal queryName As String) As Boolean
    ' Helper function to check if a query with the given name already exists
    Dim qry As WorkbookQuery
    
    If (ThisWorkbook.Queries.Count = 0) Then
        DoesQueryExist = False
        Exit Function
    End If
    
    For Each qry In ThisWorkbook.Queries
        If (qry.Name = queryName) Then
            DoesQueryExist = True
            Exit Function
        End If
    Next
    DoesQueryExist = False
End Function


Sub LoadToWorksheetOnly(query As WorkbookQuery, currentSheet As Worksheet)
    ' The usual VBA code to create ListObject with a Query Table
    ' The interface is not new, but looks how simple is the conneciton string of Power Query:
    ' "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & query.Name
     
    With currentSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & query.Name _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdDefault
        .CommandText = Array("SELECT * FROM [" & query.Name & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = False
        .Refresh BackgroundQuery:=False
    End With
     
End Sub

CodePudding user response：

Here's an example using VBA-JSON (https://github.com/VBA-tools/VBA-JSON)

It's pretty straightforward.

Sub TestAddRows()
    Dim files As Collection, json As Object, f, lo As ListObject
    Dim rw As Range
    
    Set lo = Sheet6.ListObjects(1)  'Target table/listobject
    
    Set files = PickFiles()         'user selects data files
    For Each f In files
        Set json = JsonConverter.ParseJson(GetContent(CStr(f))) 'parse the json content
        'add a row and populate it
        lo.ListRows.Add.Range.Value = Array( _
            json("name"), json("score1"), json("scoreX"), _
            json("TestXY")("scoreXYa"), json("TestXY")("scoreXYb"))
    Next f
End Sub

Function PickFiles() As Collection
    Dim f As Variant, rv As New Collection
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Select one or more JSON files"
        .Filters.Clear
        .Filters.Add "JSON files", "*.json"
        If .Show Then
            For Each f In .SelectedItems
                rv.Add f
            Next
        End If
    End With
    Set PickFiles = rv
End Function

Function GetContent(f As String) As String
    GetContent = CreateObject("scripting.filesystemobject"). _
                  OpenTextFile(f, 1).ReadAll()
End Function