Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to use the Json dictionary & collection in VBA Ms Access

Status
Not open for further replies.

mwiinde

Programmer
Sep 21, 2019
4
ZM
Hi Experts!

I need help from you, I want to allocate the select query data below in the correct Json format that is acceptable by our company:

(1) Example the customer details must appear in the in the dictionary {}
(2) The product sales data must appear in the collection part []
(3) The tax details must appear in the collection but nested array

Select query:

SQL:
SELECT tblInvoice.INV, tblInvoicedetails.ItemID, tblProducts.Description, tblProducts.BarCode, tblInvoicedetails.Qty, tblInvoicedetails.UnitPrice, tblInvoicedetails.Discount, tblInvoicedetails.Taxables, tblInvoicedetails.Inclusive, tblInvoicedetails.RRP, DateAdd("d",1,[InvoiceDate]) AS DocumentDate, tblCustomers.CustomerName, tblCustomers.TPIN, tblInvoice.InvoiceDate
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.Description
WHERE (((tblInvoice.INV)=[Forms]![frmInvoice]![CboInv]));

Notes

I have a properly installed Json bas converter in my Ms Access project and below is my main function I'm trying to build, quite okay the function works well but it does not give chance to allocate the data that need to go into either directory {} or collection [] or nested dictionary/collection

Code:
Private Sub CmdSales_Click()
  
'  Const SQL_SELECT As String = "SELECT * FROM Qry3;"
  
  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("Qry4")
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), vbOKOnly, "Audited by Chris Hankwembo"
  Set coll = Nothing
End Sub
The Json format required is below:

JSON:
{
"customer":"lukas"
"address":"avondale"
"date":"2019-09-25"
"items":[
{
"itemid": 1,
"description":"apple",
"product code":"G100256",
"quantity":10,
"unit price":2,
"discounts":5%,
"tax":[
"Z",
"K"
],
"total":38
"inclusiveTax":no,
"final":0
},
{
"itemid": 2,
"description":"orange",
"product code":"GK1002876",
"quantity":10,
"unit price":2,
"discounts":5%,
"tax":[
"Z",
"K"
],
"total":38
"inclusiveTax":no,
"final":0
},
{
 "itemid": 3,
"description":"lemon",
"product code":"ZK1002976",
"quantity":10,
"unit price":2,
"discounts":5%,
"tax":[
"Z",
"K"
],
"total":38
"inclusiveTax":no,
"final":0
}
]
}

That is what I want to archive.

Your help on this will be highly appreciated!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top