MS Access VBA Forms parameter queries

Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc used Ask the Experts™
on
The code below works excellent but just need also a parameter so that only some selected record can be pulled.
My form parameter is called CboINV.

Private Sub CmdSales_Click()
 Const SQL_SELECT As String = "SELECT TOP 3 * FROM Qry1;"
  
  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
  
  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, "Checked By Chris Hankwembo"
  Set coll = Nothing
End Sub

Open in new window



I tried to  add the other pieces of code in Ms access VBA but still it does not want. What a torture? I think once I'm through with this I need to take a 2 weeks holiday

Dim qdf As Dao.QuerDef
Dim prm As Dao.Parameter

Set bs = qdf.query("SQL_SELECT")

For Each prm In qdf.Parameters
prm = Eval(prm.Name)
Next prm
Set qdf = Nothing

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Jim Dettman (EE MVE)President / Owner
Most Valuable Expert 2017
Most Valuable Expert 2012

Commented:
Well for a start, you would want:

Set bs = qdf.query("Qry1")

But since you are already doing the SQL in the code, there's no real need for Qry1

Open Qry1 in design view, switch to SQL view and that's the statement you want to put in here:

Const SQL_SELECT As String = "SELECT TOP 3 ..."

 and make it a normal string variable.   You don't want a constant.

Do that and show the code again and will take it to the next step.

Jim.
Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
As for your loop, set the query, then open the recordset:

Dim qdf As DAO.QuerDef
Dim prm As DAO.Parameter

Set qdf = CurrentDb.QueryDefs("SQL_SELECT")
For Each prm In qdf.Parameters
    prm = Eval(prm.Name)
Next prm
Set bs = qdf.OpenRecordset()

Set qdf = Nothing

Open in new window

Hi Gustav

Its still giving error message ERROR 3061 Few parameters EXpected 1

Option Compare Database
Option Explicit
Private Sub CmdSales_Click()
  
  Const SQL_SELECT As String = "SELECT * FROM Qry1;"
  
  Dim coll As VBA.Collection
  Dim dict As Scripting.Dictionary
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim bs As DAO.Recordset
  Dim fld As DAO.Field
  Dim qdf As DAO.QueryDef
  Dim prm As DAO.Parameter
  Set coll = New VBA.Collection
  Set db = CurrentDb
  Set rs = db.OpenRecordset(SQL_SELECT, dbOpenSnapshot)
  Set qdf = CurrentDb.QueryDefs("SQL_SELECT")
For Each prm In qdf.Parameters
    prm = Eval(prm.Name)
Next prm
Set bs = qdf.OpenRecordset()
  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

Open in new window




Parameter-query-error.png
Should you be charging more for IT Services?

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

For testing purpose find attached database

Kindly check
Training.accdb
Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
It will only work if the parameters have names that actually can be evaluated, typically like: [Forms]![SomeForm]![SomeControl] and the form is open.
Try this:

For Each prm In qdf.Parameters
    prm.Value = Eval(prm.Name)
    Debug.Print prm.Name & ":", prm.Value
Next prm

Open in new window

and study the output.
Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
For testing purpose find attached database

It works for me if the form is open.
Still I have some challenges

Error 3061 still pops up


invoiceErrors3061.png


Full code below

Option Compare Database
Option Explicit
Private Sub CmdSales_Click()
  
  Const SQL_SELECT As String = "SELECT * FROM Qry1;"
  
  Dim coll As VBA.Collection
  Dim dict As Scripting.Dictionary
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim bs As DAO.Recordset
  Dim fld As DAO.Field
  Dim qdf As DAO.QueryDef
  Dim prm As DAO.Parameter
  Set coll = New VBA.Collection
  Set db = CurrentDb
  Set rs = db.OpenRecordset(SQL_SELECT, dbOpenSnapshot)
  Set qdf = CurrentDb.QueryDefs("SQL_SELECT")
For Each prm In qdf.Parameters
    prm.Value = Eval(prm.Name)
    Debug.Print prm.Value & ":", prm.Value
Next prm
Set bs = qdf.OpenRecordset()
  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

Open in new window


Form Name is below:

[Forms]![frmInvoice]![CboINV]


SELECT tblInvoice.INV, tblInvoice.Customer, tblCustomers.TaxID, tblCustomers.Address, tblInvoice.InvoiceDate, tblInvoicedetails.Product, tblInvoicedetails.Qty, tblInvoicedetails.Price, tblInvoicedetails.VAT, (([Qty]*[Price])*(1+[VAT])) AS TotalPrice
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.Product
WHERE (((tblInvoice.INV)=[Forms]![frmInvoice]![CboInv]));

Open in new window

Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
It is not the form.
But you can't open the recordset before having set the query. See my sample posted previously.
Kindly check my simple application here , you will see for yourself that it has some error as per screen shoot

Parameter-query-error.png

Amended code


Option Compare Database
Option Explicit
Private Sub CmdSales_Click()
  
  Const SQL_SELECT As String = "SELECT * FROM Qry1;"
  
  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 qdf = db.QueryDefs("SQL_SELECT")
For Each prm In qdf.Parameters
    prm = Eval(prm.Name)
Next prm
Set qdf = 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)
  Set coll = Nothing
End Sub

Open in new window

Training.accdb
Distinguished Expert 2017

Commented:
What is the purpose of building a collection?  A query with a where clause that limits the records selected seems to be all you need and you can bind the query to a form or report or use it in a VBA loop.
Most Valuable Expert 2015
Distinguished Expert 2018
Commented:
You must pay much more attention to setting objects and in the right order, or you will continue to bump into issues.

Your code runs with these corrections:

Private Sub CmdSales_Click()
  
'  Const SQL_SELECT As String = "SELECT * FROM Qry1;"
  
  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("Qry1")
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)
  Set coll = Nothing
End Sub

Open in new window

json.PNG
Gustav

Thank you so much it has truly worked , this is clearly another rescue from deep waters

Regards

Chris
Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
You are welcome!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial