Solved Do until Loop Problem with VBA (1 Viewer)

[ebs17]

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.

 

[theDBguy]

The product names were still not coming through

I think part of the problem there is because you're using lookup fields at the table level.

The Access Web - The Evils of Lookup Fields in Tables

 

[nector]

The code below works but it does not pick the products names instead it is putting "Descriptions"

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:

{
   "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
         }
      ]
   }
}

 

[nector]

Kindly note that the products should never be hard coded , should come straight from SEL;ECT query

 

[theDBguy]

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.

 

[Minty]

@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.

 

[MarkK]

rather than leading us all down a rabbit hole

You can lead a horse to a rabbit hole, but you can't make him, wait, crap, f**ked it up.

 

[isladogs]

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?

{
   "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

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!

 

[Edgar_]

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.

 

[Isaac]

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:

 

[isladogs]

Well, my eyes see this picture they uploaded:

View attachment 111458

OK - but I read the code that you quoted rather than a picture from another post that's showing something else

 

[Isaac]

OK - but I read the code that you quoted rather than a picture from another post that's showing something else

Okay

 

[nector]

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

Regards

nector