Solved Do until Loop Problem with VBA

N

nector

Member
Local time
Today, 09:01
Joined
Jan 21, 2020
Messages
577
For the first time I encountered an error while using Do until loop on a simple database but on the more complex database its working okay , its very embarrassing to have such issues sure.

Where do I go wrong?

The error only occurs when I use the on click but not on compiling , see the picture attached and database


Code: 
Option Compare Database
Option Explicit
Private Sub CmdSales_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim Company As New Dictionary
Dim data As New Dictionary
Dim transactions As Collection
Dim itemCount As Long
Dim i As Long
Dim item As New Dictionary
Set data = New Dictionary
Set transactions = New Collection
Set db = CurrentDb
    Set qdf = db.QueryDefs("QryJson")
    For Each prm In qdf.Parameters
        prm = Eval(prm.Name)
    Next prm
    Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)
    Set qdf = Nothing
    rs.MoveFirst
    Do Until rs.EOF
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
Company.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
            item.Add "Description", DLookup("Description", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))
            item.Add "Qty", DLookup("Qty", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))
            item.Add "UnitPrice", DLookup("UnitPrice", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))
        
    Next i
    Debug.Print JsonConverter.ConvertToJson(Company, Whitespace:=3)
    rs.Close
    Loop
    Set rs = Nothing
    Set db = Nothing
    Set transactions = Nothing
    Set item = Nothing
    Set qdf = Nothing
    Set prm = Nothing
    End Sub


JobTwo errors.png
 

Attachments

I'm confused , what does the picture have to do with the code window? They are completely different.

The code as posted is very odd, you open a recordset (rs) and then loop around it but don't actually appear to use any of the rs data??
What's the point?
 
More confused because that code is not in the db.
dbFailOnError should provide a message. What is the message.
I would put in a
debug.print .sql so you can ensure that the sql is what you expect.
 
Sorry people I posted a wrong code my apologies. See the picture below this now correct



Do until loop.png
 
Try commenting out or move this line towards the bottom.
Code: 
Set qdf = Nothing
 
On top of the DBGuy's comment -
That doesn't change my statement, what are you expecting the recordset to do or hold in terms of data, as you aren't using it anywhere?
 
The data is used under Dlookup just see the last codes you will QryJson

Code: 
'--- 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", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))
            item.Add "Qty", DLookup("Qty", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))
            item.Add "UnitPrice", DLookup("UnitPrice", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))


Commenting 'Set Qdf = Nothing does not change anything at all


Code: 
'Set qdf = Nothing
 
try removing dbseechanges - it is not relevant to a snapshot, only a dynaset
 
If you don't mind me being thick on a Friday afternoon, can you highlight where?
Because "QryJson" is not your recordset even if that's where it came from?
 
try removing dbseechanges - it is not relevant to a snapshot, only a dynaset

Nothing works

I never thought this could a problem
 
Sorry for the Double post
You also never move through the recordset and close it before you might do (no idea how without a rs.movenext) with the Loop command.

Nothing about that makes any sense whatsoever...

Have you actually stepped through the code with F8 to see it in action? and examine the values?
 
If you don't mind me being thick on a Friday afternoon, can you highlight where?
Because "QryJson" is not your recordset even if that's where it came from?


Here the recordset is the QryJson that is the one I'm Looping

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

Attachments

this is why properly indenting your code would have shown the problem after the 1st post, not the 12th post, saving you and us a lot of time and wasted effort. Also indicates you did not bother stepping through the code to check what is actually happening

check your loop - you close rs at the end of the loop, so when you come to check for eof - rs is no longer set
 
SO what are you creating this recordset for?
Code: 
Private Sub CmdSales_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim qdf As DAO.QueryDef
    Dim prm As DAO.Parameter
    Dim Company As New Dictionary
    Dim data As New Dictionary
    Dim transactions As Collection
    Dim itemCount As Long
    Dim i As Long
    Dim item As New Dictionary
    Set data = New Dictionary
    Set transactions = New Collection
    Set db = CurrentDb
    Set qdf = db.QueryDefs("QryJson")
    For Each prm In qdf.Parameters
        prm = Eval(prm.Name)
    Next prm
    Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)    ''' THIS RECORDSET HERE!
    Set qdf = Nothing          
    rs.MoveFirst                                                '''' And here  
    Do Until rs.EOF                                                '''' And this loop here    
        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
        Company.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
            item.Add "Description", DLookup("Description", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))
            item.Add "Qty", DLookup("Qty", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))
            item.Add "UnitPrice", DLookup("UnitPrice", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))
       
        Next i
        Debug.Print JsonConverter.ConvertToJson(Company, Whitespace:=3)
        rs.Close
    Loop
    Set rs = Nothing
    Set db = Nothing
    Set transactions = Nothing
    Set item = Nothing
    Set qdf = Nothing
    Set prm = Nothing
End Sub

See the problem here:
1702655091596.png
 
nector said:
Commenting 'Set Qdf = Nothing does not change anything at all
Click to expand...
If this is related to your other post, did you check out the file I posted there? I only used rs and removed itemcount. Does it not do what you wanted? Just curious...

Solved - How to stop VBA from repeating Json output according to number of products

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...
www.access-programmers.co.uk
 
Also out of interest why did you modify the code I suggested in the other post to use ItemID = " & CStr(i)) when ItemID and i are both long integers?
Doing that makes no sense to me and I'd be surprised if it still works. It worked perfectly as originally written
 
nector said:
For the first time I encountered an error while using Do until loop on a simple database but on the more complex database its working okay , its very embarrassing to have such issues sure.

Where do I go wrong?

The error only occurs when I use the on click but not on compiling , see the picture attached and database


Code: 
Option Compare Database
Option Explicit
Private Sub CmdSales_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim Company As New Dictionary
Dim data As New Dictionary
Dim transactions As Collection
Dim itemCount As Long
Dim i As Long
Dim item As New Dictionary
Set data = New Dictionary
Set transactions = New Collection
Set db = CurrentDb
    Set qdf = db.QueryDefs("QryJson")
    For Each prm In qdf.Parameters
        prm = Eval(prm.Name)
    Next prm
    Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)
    Set qdf = Nothing
    rs.MoveFirst
    Do Until rs.EOF
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
Company.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
            item.Add "Description", DLookup("Description", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))
            item.Add "Qty", DLookup("Qty", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))
            item.Add "UnitPrice", DLookup("UnitPrice", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))
      
    Next i
    Debug.Print JsonConverter.ConvertToJson(Company, Whitespace:=3)
    rs.Close
    Loop
    Set rs = Nothing
    Set db = Nothing
    Set transactions = Nothing
    Set item = Nothing
    Set qdf = Nothing
    Set prm = Nothing
    End Sub


View attachment 111453
Click to expand...


You should always declare a dao.database object, and then Set it to currentdb
RATHER than executing code directly on currentdb

Currentdb is known to lose its mojo in similar situations.
This may or may not be your current problem but need to fix anyway
 
Also out of interest why did you modify the code I suggested in the other post to use ItemID = " & CStr(i)) when ItemID and i are both long integers?
Doing that makes no sense to me and I'd be surprised if it still works. It worked perfectly as originally written

The product names were still not coming through


Even the code below still throughs the error


Code: 
Option Compare Database
Option Explicit
Private Sub CmdSales_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim qdf As DAO.QueryDef
    Dim prm As DAO.Parameter
    Dim Company As New Dictionary
    Dim data As New Dictionary
    Dim transactions As Collection
    Dim itemCount As Long
    Dim i As Long
    Dim item As New Dictionary
    Set data = New Dictionary
    Set transactions = New Collection
    Set db = CurrentDb
    Set qdf = db.QueryDefs("QryJson")
    For Each prm In qdf.Parameters
        prm = Eval(prm.Name)
    Next prm
    Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)    ''' THIS RECORDSET HERE!
    Set qdf = Nothing
    rs.MoveFirst                                                '''' And here
    Do Until rs.EOF                                                '''' And this loop here
        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
        Company.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
            item.Add "Description", DLookup("Description", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))
            item.Add "Qty", DLookup("Qty", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))
            item.Add "UnitPrice", DLookup("UnitPrice", "QryJson", "[INV] =" & Me.CboInv & " And ItemID = " & CStr(i))
      
        Next i
        Debug.Print JsonConverter.ConvertToJson(Company, Whitespace:=3)
        rs.Close
    Loop
    Set rs = Nothing
    Set db = Nothing
    Set transactions = Nothing
    Set item = Nothing
    Set qdf = Nothing
    Set prm = Nothing
End Sub

Do until loop.png
 
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?
 
You must log in or register to reply here.

Similar threads

N
VBA Code error on the counter
Replies
5
Views
758
cheekybuddha
cheekybuddha
N
VBA MS Access Error Handling
Replies
5
Views
1,116
Pat Hartman
P
N
Solved Caching recordset in MS Access VBA
2
Replies
26
Views
3,587
tvanstiphout
T
N
Solved Progress meter for reports & queries in MS Access
Replies
16
Views
2,093
tvanstiphout
T
N
Solved Big variation when sending data through Cloud SQL Server Vs MS Access
Replies
10
Views
1,282
Pat Hartman
P

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom