How to Convert Ms Access query data into Json String

[mwiinde]

I have a VBA code which feeds the Json string perfect well after using GITHUB convertor.Below is my actual Ms Access select query which supply data to my :

SELECT tblInvoice.INV, tblInvoice.Customer, tblCustomers.TaxID, tblCustomers.Address, DateAdd("d",1,[InvoiceDate]) AS SalesDate, tblCustomers.ItmesID, tblInvoicedetails.Product, tblInvoicedetails.Qty, tblInvoicedetails.Price, tblInvoicedetails.VAT, (([Qty]*[Price])*(1+[VAT])) AS TotalPrice
FROM tblProducts INNER JOIN ((tblCustomers INNER JOIN tblInvoice ON tblCustomers.ID = tblInvoice.Customer) INNER JOIN tblInvoicedetails ON tblInvoice.INV = tblInvoicedetails.INV) ON tblProducts.PDID = tblInvoicedetails.Product
WHERE (((tblInvoice.INV)=[Forms]![frmInvoice]![CboInv]));

I want my Json to appear like below:

{
"Customer":"Customer"
"TaxID": "TaxID"
"Address":"Address"
"InvoiceDate":"InvoiceDate",
"Items:[
"ItemId":"ItemId"
"Product":"Product"
"Qty":"Qty"
"UnitPrice":"UnitPrice"
"TotalPrice":"TotalPrice",
]
{
[
"T":"T"
"B": "B"
]
}
}

The issue here how to insert the follwong in Json:

(1) Object
(2) Nested Object

VBA Code

Option Compare Database
Option Explicit
Private Sub CmdSales_Click()
  
'  Const SQL_SELECT As String = "SELECT * FROM Qry1;"
  Dim http As Object
  Dim coll As VBA.Collection
  Dim dict As Scripting.Dictionary
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim fld As DAO.Field
  Dim qdf As DAO.QueryDef
  Dim prm As DAO.Parameter
  Set db = CurrentDb
  Set qdf = db.QueryDefs("Qry1")
For Each prm In qdf.Parameters
    prm = Eval(prm.Name)
Next prm
Set rs = qdf.OpenRecordset()

Set qdf = Nothing
  Set coll = New VBA.Collection
'  Set db = CurrentDb
'  Set rs = db.OpenRecordset(SQL_SELECT, dbOpenSnapshot)
  If Not rs.BOF And Not rs.EOF Then
    Do While Not rs.EOF
      Set dict = New Scripting.Dictionary
      For Each fld In rs.fields
        dict.Add fld.Name, rs.fields(fld.Name).Value
      Next fld

      coll.Add dict
      rs.MoveNext
    Loop
  End If

  rs.Close
  Set fld = Nothing
  Set rs = Nothing
  Set db = Nothing
  Set dict = Nothing
  MsgBox JsonConverter.ConvertToJson(coll, Whitespace:=3)
  Set coll = Nothing
End Sub

Regards

Chris