Solved Do until Loop Problem with VBA

Code:
Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)    ''' THIS RECORDSET HERE!
The recordset isn't actually used in the code. You run a loop, but nowhere is a value from this recordset queried or even used. What hidden meaning lies behind it?

By the way: rs.MoveFirst is unnecessary and even dangerous.
When a recordset is newly opened, the pointer is always on the first record, or on EOF if the recordset is empty. In the second case, MoveFirst generates a runtime error.

Oh, I think some originally working code has been heavily reworked.
 
The code below works but it does not pick the products names instead it is putting "Descriptions"

Code:
Option Compare Database
Option Explicit
Private Sub CmdSales_Click()
Dim Company As New Dictionary
Dim Json As Object
Dim data As New Dictionary
Dim transactions As Collection
Dim productlist As New Dictionary
Dim itemCount As Long
Dim i As Long
Dim item As New Dictionary
Dim items As New Collection
Set data = New Dictionary
Set productlist = New Dictionary
Set transactions = New Collection
Set Company = New Dictionary
        Company.Add "Tpin", "1002623668"
        Company.Add "bhfld", "00"
        Company.Add "InvoiceNo", 15
        Company.Add "receipt", data
        data.Add "CustomerTpin", "1001102603"
        data.Add "CustomerMblNo", Null
        data.Add "itemList", transactions
              
'thedbguy@gmail.com
'12/14/2023

'        '--- 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)
'        item.Add "Qty", DLookup("Qty", "tblInvoicedetails", "[INV] =" & Me.CboInv)
'        item.Add "UnitPrice", DLookup("UnitPrice", "tblInvoicedetails", "[INV] =" & Me.CboInv)
'
'    Next i

Dim rs As DAO.Recordset
Dim varDesc As Variant
Dim varQty As Variant
Dim varPrice As Variant

Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblInvoiceDetails WHERE INV=" & Me.CboInv, dbOpenSnapshot)

With rs
    Do While Not .EOF
        varDesc = !Description
        varQty = !Qty
        varPrice = !UnitPrice
        Set item = New Dictionary
        transactions.Add item
        item.Add "ItemId", i + 1
        item.Add "Description", varDesc
        item.Add "Qty", varQty
        item.Add "UnitPrice", varPrice
        .MoveNext
        i = i + 1
    Loop
    .Close
End With

Set rs = Nothing

    Debug.Print JsonConverter.ConvertToJson(Company, Whitespace:=3)
    
    End Sub

Immediate window see below:



Code:
{
   "Tpin": "1002623668",
   "bhfld": "00",
   "InvoiceNo": 15,
   "receipt": {
      "CustomerTpin": "1001102603",
      "CustomerMblNo": null,
      "itemList": [
         {
            "ItemId": 1,
            "Description": 1,
            "Qty": 251,
            "UnitPrice": 41
         },
         {
            "ItemId": 2,
            "Description": 2,
            "Qty": 330,
            "UnitPrice": 41
         },
         {
            "ItemId": 3,
            "Description": 3,
            "Qty": 421,
            "UnitPrice": 41
         }
      ]
   }
}
 
Kindly note that the products should never be hard coded , should come straight from SEL;ECT query
 
Kindly note that the products should never be hard coded , should come straight from SEL;ECT query
Modify your query to add the products table and pull the description column from there.
 
@nector - I'm a little bemused, the code you are now displaying is completely different to the code in the OP.
We have all asked you what was the purpose of the recordset, it now looks obvious you have just plonked a random bit of code into the middle of some previously working code, and are wondering why it doesn't work...

Please, take a step back and think carefully about what you are doing and if you don't really understand something's workings, then ask, rather than leading us all down a rabbit hole with no purpose.
 
OK - now I understand thanks to DBG's comments about table level lookup fields which are a very bad idea
So is this the JSON output you actually want?

Code:
{
   "Tpin": "1002623668",
   "bhfld": "00",
   "InvoiceNo": 15,
   "receipt": {
      "CustomerTpin": "1001102603",
      "CustomerMblNo": null,
      "itemList": [
         {
            "ItemId": 1,
            "Description": "Apple( 350 ML)",
            "Qty": 215,
            "UnitPrice": 41
         },
         {
            "ItemId": 2,
            "Description": "Orange (350 ML)",
            "Qty": 330,
            "UnitPrice": 41
         },
         {
            "ItemId": 3,
            "Description": "Lemonade (350 ML)",
            "Qty": 421,
            "UnitPrice": 41
         }
      ]
   }
}

If so, the code from the other thread could be updated as follows. Not elegant but it will work

Code:
Private Sub CmdSales_Click()
Dim Company As New Dictionary
Dim Json As Object
Dim data As New Dictionary
Dim transactions As Collection
Dim productlist As New Dictionary
Dim itemCount As Long
Dim i As Long
Dim PD As Long
Dim item As New Dictionary
Dim items As New Collection
Set data = New Dictionary
Set productlist = New Dictionary
Set transactions = New Collection
Set Company = New Dictionary
        Company.Add "Tpin", "1002623668"
        Company.Add "bhfld", "00"
        Company.Add "InvoiceNo", 15
        Company.Add "receipt", data
        data.Add "CustomerTpin", "1001102603"
        data.Add "CustomerMblNo", Null
        data.Add "itemList", transactions
             
        '--- loop over all the items
        itemCount = Me.txtProductcount
       
        For i = 1 To itemCount
            Set item = New Dictionary
            transactions.Add item
            item.Add "ItemId", i
            PD = DLookup("Description", "tblInvoicedetails", "[INV] =" & Me.CboInv & " And ItemID = " & i) 'get the ProductID
            item.Add "Description", DLookup("Description", "tblProducts", "PDID =" & PD) 'get the product description
            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

I'll leave you to try & do the rest!
 
is this the JSON output you actually want?
OP, if the posters don't know the JSON structure you expect, this is going to be a terrible experience for everyone. Better be clear with that.
 
As I said I tested the code I provided and it worked for me. Casting a long to a string won’t help here

@Isaac
Not sure why you mentioned that point as the OP is already doing that. Perhaps I’m missing something?

Well, my eyes see this picture they uploaded:

1702665800787.png
 
Many thanks to all the helpers highly appreciated all your comments are greatly appreciated.

Regards

nector
 

Users who are viewing this thread

Back
Top Bottom