Solved How to stop VBA from repeating Json output according to number of products (1 Viewer)

nector

Member
Local time
Today, 15:26
Joined
Jan 21, 2020
Messages
368
I have created a VBA sub which convert the raw data into Json , the issue is that when you view the output after selecting the invoice number and click post in the immediate you will find that its repeating the header according to the number of products on the invoice instead of just once and the correct list of products as below. To see what I'm saying , just select invoice number 2 from the select inv to conv to Json combo box and then post , then go to the form's immediate window to view the results

The desired output should look like below:


Code:
{
   "Tpin": "1002623668",
   "bhfld": "00",
   "InvoiceNo": 15,
   "receipt": {
      "CustomerTpin": "1001102603",
      "CustomerMblNo": null,
      "itemList": [
         {
            "ItemId": 1,
            "Description": 1,
            "Qty": 215,
            "UnitPrice": 41
         },
         {
            "ItemId": 2,
            "Description": 1,
            "Qty": 215,
            "UnitPrice": 41
         },
         {
            "ItemId": 3,
            "Description": 1,
            "Qty": 215,
            "UnitPrice": 41
         }
      ]
   }
}

I'm not sure how to correct the issue above
 

Attachments

  • test.accdb
    2.8 MB · Views: 35

isladogs

MVP / VIP
Local time
Today, 13:26
Joined
Jan 14, 2017
Messages
18,225
Move the Debug.Print line out of the loop

Code:
...

 Next i
    
    Debug.Print JsonConverter.ConvertToJson(Company, Whitespace:=3)
...
 

nector

Member
Local time
Today, 15:26
Joined
Jan 21, 2020
Messages
368
Many thanks to isladogs it working the way I wanted it.

Regards

Nector
 

isladogs

MVP / VIP
Local time
Today, 13:26
Joined
Jan 14, 2017
Messages
18,225
You're welcome.
Hopefully you understand why it was behaving incorrectly before & why that solution worked!
 

nector

Member
Local time
Today, 15:26
Joined
Jan 21, 2020
Messages
368
Oh no the Dlookup is not picking the unique values. The fields below are incorrect:
(1) Its duplicating the QTY , Descriptions and Price in all lines

See below

Code:
{
            "ItemId": 1,
            "Description": 1,
            "Qty": 215,
            "UnitPrice": 41
         },
         {
            "ItemId": 2,
            "Description": 1,
            "Qty": 215,
            "UnitPrice": 41
         },
         {
            "ItemId": 3,
            "Description": 1,
            "Qty": 215,
            "UnitPrice": 41
         }
 

isladogs

MVP / VIP
Local time
Today, 13:26
Joined
Jan 14, 2017
Messages
18,225
I did wonder, but that was what you said you wanted in post #1

DLookup will return the first record that satisifies the specified criteria.
So to get the desired result for each of the records, you also need to specify the ItemID in the DLookup:

Code:
Private Sub CmdSales_Click()

...'first section of code here
              
        '--- loop over all the items
        itemCount = Me.txtProductcount
        
        For i = 1 To itemCount
            Set item = New Dictionary
            transactions.Add item
            item.Add "ItemId", i
            item.Add "Description", DLookup("Description", "tblInvoicedetails", "[INV] =" & Me.CboInv & " And ItemID = " & i)
            item.Add "Qty", DLookup("Qty", "tblInvoicedetails", "[INV] =" & Me.CboInv & " And ItemID = " & i)
            item.Add "UnitPrice", DLookup("UnitPrice", "tblInvoicedetails", "[INV] =" & Me.CboInv & " And ItemID = " & i)
            
        Next i
    
        Debug.Print JsonConverter.ConvertToJson(Company, Whitespace:=3)
    
    End Sub

That does give the correct output.
 
Last edited:

theDBguy

I’m here to help
Staff member
Local time
Today, 05:26
Joined
Oct 29, 2018
Messages
21,473
I don't claim to know anything about this, but I tried to use a recordset to see if I can make it work. It was interesting how I had to jump through hoops to make it do what you wanted.
 

Attachments

  • test (4).zip
    210.2 KB · Views: 43

nector

Member
Local time
Today, 15:26
Joined
Jan 21, 2020
Messages
368
Many thanks to you @isladogs , I never thought of that approach only a genius can do that we lucky to have you on this platform.

Regards

Nector
 

isladogs

MVP / VIP
Local time
Today, 13:26
Joined
Jan 14, 2017
Messages
18,225
Very kind of you but to be honest it was just a very straightforward use of DLookup
 

Users who are viewing this thread

Top Bottom