Solved How get lid of domain function and replace them with opening recordset in MS Access VBA (4 Viewers)

[nector]

The program below works very fine no errors whatsoever; we have also made sure that all the tables have primary keys and foreign keys to easy searching records. However, someone whispered to me yesterday that the domain functions included in your VBA will be slowing the speed and the solution to increase the speed of the program further is to replace them.

That is where I have a challenge because first of all if you check the VBA below, I'm opening the MS Access query called QryJsonPos001 which essentially is the provider of all the required records or fields for the program, now the challenge is that the required line items need to be picked by using TWO PARAMETERS without using those parameters , see below, the VBA code will repeating one line several times.

That is the reason why you can see that I'm using Dlookup and Dsum to accommodate the two parameters.

Requirements

Using this Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges) how do I bring in the two parameters into VBA to avoid using domain functions, for example this code works because it does not require parameters "Company.Add "cisInvcNo", rs!cisInvcNo.Value"

Questions

Now using the same concept "Company.Add "cisInvcNo", rs!cisInvcNo.Value" now how can we include the two parameters shown with the domain functions below with rs record set?

Company.Add "taxblAmtA", Nz(Round(DSum("TaxableValue", "QryJsonPos001", "[ItemSoldID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'A'"), 4), 0)

For i = 1 To itemCount
Set item = New Dictionary
transactions.Add item
item.Add "itemSeq", i
item.Add "qty", Nz(Round(DLookup("QtySold", "QryJsonPos001", "[ItemSoldID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)

MS Access VBA with open recordset

Public Sub Cmdsandboxwriting_Click()
On Error Resume Next
Call CmdCmdTotalClasses_Click
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rst As DAO.Recordset
Dim Company As New Dictionary
Dim strData As String
Dim Json As Object
Dim data As New Dictionary
Dim transactions As Collection
Dim itemCount As Long
Dim i As Long
Dim n As Integer
Dim Z As Integer
Dim item As New Dictionary
Dim items As New Collection
Dim prm As DAO.Parameter
Dim qdf As DAO.QueryDef
Set db = CurrentDb
Set qdf = db.QueryDefs("QryJsonPos001")

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

Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)
    Set qdf = Nothing
    rs.MoveFirst
    Do While Not rs.EOF
Set data = New Dictionary
Set transactions = New Collection
Set Company = New Dictionary
      
Company.Add "cisInvcNo", rs!cisInvcNo.Value

Company.Add "taxblAmtA", Nz(Round(DSum("TaxableValue", "QryJsonPos001", "[ItemSoldID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'A'"), 4), 0)

For i = 1 To itemCount
Set item = New Dictionary
transactions.Add item
item.Add "itemSeq", i
item.Add "qty", Nz(Round(DLookup("QtySold", "QryJsonPos001", "[ItemSoldID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)

Actual query "QryJsonPos001"with fields just to show you for reference purpose only

SELECT tblproducts.productname,
       tblproducts.productid,
       ( Iif(([taxclassa]<>"b"), ((([qty]*[sellingprice]))), 0)
         + Iif(([taxclassa]="b"), ((([qty]*[tblposlinedetails].[rrp]))), 0) )
       AS
       TotalAmount,
( ( Iif(( [sellingprice] > [tblposlinedetails].[rrp] ), ( ((
        ( [sellingprice] ) * [tax] * 1 )) / 1.16 ), ( (( (
      [tblposlinedetails].[rrp] ) * [tax] * 1 )) / 1.16 )) ) * [qtysold] )
       AS
FinalTax,
( Iif(( [taxclassa] = "tv" ), ( ( ( [sellingprice] ) / ( 1 + [turnovertax] ) ) *
                                  [qtysold] ), ( Iif((
    [tblposlinedetails].[rrp] > [sellingprice] ), (( (
    ( [tblposlinedetails].[rrp] ) /
                                                           ( 1 + (
    Nz([tax], 0) + Nz([tourismlevy], 0) ) ) ) * [qtysold] )), (
    (
( ( [sellingprice] ) / ( 1 + ( Nz([tax], 0) + Nz([tourismlevy], 0) ) ) ) * [qtysold] ))) )) )        AS TaxableValue,
Iif(( [finaltax] IS NOT NULL ), [taxablevalue], NULL)
       AS TaxableAB,
Round(( Nz([finaltax], 0) + Nz([taxablevalue], 0) ), 2)
       AS TaxInclusive,
( Iif(([taxclassa]<>"b"), ((([qtysold]*[sellingprice]))), 0)
  + Iif(([taxclassa]="b"), ((([qtysold]*[tblposlinedetails].[rrp]))), 0) )
       AS
SupplierAmount,
( (( Iif(( [taxclassa] = "tv" ), ( ( ( [sellingprice] ) / ( 1 + [turnovertax] )
                                   )
                                     *
                                        [qtysold] ), ( Iif((
          [tblposlinedetails].[rrp] > [sellingprice] ), (( (
          ( [tblposlinedetails].[rrp] ) /
                                                                 ( 1 + (
          Nz([tax], 0) + Nz([tourismlevy], 0) ) ) ) * [qtysold] )), (
          (
( ( [sellingprice] ) / ( 1 + ( Nz([tax], 0) + Nz([tourismlevy], 0) ) ) ) * [qtysold] ))) )) )) * 0 ) AS DiscountValue,
tblproducts.itemclscd,
tblproducts.itemcd,
tblproducts.barcode,
tblposstockssold.itemsoldid,
tblposlinedetails.taxclassa,
tblposstockssold.thenotes,
tblposstockssold.cashier,
tblposlinedetails.qtysold,
tblposlinedetails.sellingprice,
tblposstockssold.orignalinvoicenumber,
tblposstockssold.orignalinvoicecode,
( (( ( [tblposlinedetails].[rrp] ) * [tax] * 1 )) / 1.16 )
       AS RRPrice,
tblposlinedetails.tax,
Nz(0, 0)
       AS prcOrdCd,
""
       AS prcOrdCdss,
Iif(( [doccodes] = "s" ), Nz([prcordcd], 0), [prcordcdss])
       AS NewprcOrdCd,
tbldocuments.doccodes,
Format((( Iif(( [doccodes] = "s" ), Now(), NULL) )), "yyyymmddhhnnss")
       AS
stockreleasing,
Format(( Now() ), "yyyymmddhhnnss")
       AS ActualDate,
Iif(( [doccodes] = "s" ), "n", "y")
       AS prchrAcptcYn,
Iif(( [doccodes] = "s" ), NULL, "05")
       AS rfdRsnCding,
tbldocuments.doctype,
tblposstockssold.posdate,
tblposstockssold.bhfid,
tblposstockssold.suptpin,
tbldocuments.docid,
( Iif(( [doccodes] = "r" ), ( [qtysold] *- 1 ), [qtysold]) )
       AS Qty,
[tblposstockssold].[itemsoldid] & "kzvzrn2571"
       AS cisInvcNo,
tblposstockssold.refundreason,
tblposstockssold.fcrate,
tblposstockssold.currencytype,
tblposstockssold.rfdrsncd,
tblposstockssold.actionrefundtype,
tblposstockssold.actiondebitnotereason,
tblposstockssold.debitnotereason,
tblposstockssold.selectcodesale,
tblposstockssold.salescode,
tblposstockssold.rejectedstatus,
tblposstockssold.inncancel,
tblposlinedetails.itemesid
FROM   (tblposstockssold
        INNER JOIN tbldocuments
                ON tblposstockssold.docid = tbldocuments.docid)
       INNER JOIN (tblproducts
                   INNER JOIN tblposlinedetails
                           ON tblproducts.productid =
                              tblposlinedetails.productid)
               ON tblposstockssold.itemsoldid = tblposlinedetails.itemsoldid
WHERE  (
( ( tblposstockssold.itemsoldid ) = [forms] ! [frmposstockssold] ! [cboesdss] )
AND ( ( tblposstockssold.inncancel ) IS NULL ) )
ORDER  BY tblposlinedetails.itemesid;

 

[arnelgp]

alternative use tLookup() and other domain lookup alternative:

Solved - Replace Dlookup with as Sql Query

Good day gentlemen, I have Dlookup code as follow , and its work fine [username_txtbox]=DLookup("user_fullname", "users_data", "[user_id]= [user_txtbox]") but, is that possible to replace it with Sql query in vba and assign result to [username_txtbox] Thanks ☺️,,

www.access-programmers.co.uk

 

[RonPaii]

Use a parameter query, then update the index parameter in the loop. To make it faster, save the query.

Dim qryNextValue As DAO.QueryDef
Set qryNextValue _
        = CurrentDb.CreateQueryDef(vbNullString, _
            "PARAMETERS " & _
                "JasonReceived Text (255), " & _
                "IDCounter Text (255); " & _
            "SELECT QryJsonPos001.QtySold " & _
            "FROM QryJsonPos001 " & _
            "Where " & _
                "QryJsonPos001.ItemSoldID = [JasonReceived] " & _
            "AND QryJsonPos001.ItemesID = [IDCounter];")
    qryNextValue.Parameters("ItemSoldID") = Me.txtJsonReceived
For i = 1 To itemCount
Set Item = New Dictionary
Transactions.Add Item
Item.Add "itemSeq", i
qryNextValue.Parameters("ItemesID") = CStr(i)
With qryNextValue.OpenRecordset
    Item.Add "Qty", Nz(Round(.Fields("QtySold"), 4), 0)
End With
Next

 

[tvanstiphout]

someone whispered to me yesterday that the domain functions included in your VBA will be slowing the speed

When someone says this, your first question should be: can you cite some reliable sources?
Maybe that person has done some speed tests, and can share the results with you and with this community?
Maybe this person can indicate where in your program things are too slow?

What you're NOT going to do (without more evidence) is rewrite what "works very fine no errors whatsoever".

 

[RonPaii]

When someone says this, your first question should be: can you cite some reliable sources?
Maybe that person has done some speed tests, and can share the results with you and with this community?
Maybe this person can indicate where in your program things are too slow?

What you're NOT going to do (without more evidence) is rewrite what "works very fine no errors whatsoever".

It's well known that domain functions are relatively slow which shows up in loops. Each time you use a domain function, Access needs to build a new query, create an execution plan and then open a new record set to get the result. It then needs to close and destroy the record set and query. Moving all that outside of the loop will improve performance.

 

[The_Doc_Man]

However, someone whispered to me yesterday that the domain functions included in your VBA will be slowing the speed and the solution to increase the speed of the program further is to replace them.

Anything you do using VBA will be slowing down the speed of your process by adding more to do. However, domain aggregate functions DO add an extra speed-bump because they perform a hidden query that you never see. Each such function performs the equivalent of an OpenRecordset, possibly a recordset.FindFirst, a value extraction, and a recordset.Close, so how much extra work does that add?

If you have to extract several items from the same record in a recordset, you CAN open the recordset, find the record, and do multiple extractions before closing down the recordset. AND if your code would loop through the recordset you can just open that recordset outside of your loop, only use .FindFirst inside the loop, and close the recordset when you leave the loop. Thus bypassing all of the open and close operations implicit in any Domain Aggregate function.

 

[June7]

Your DLookup as shown should fail anyway because it lacks a space in front of AND operator.

Company.Add "taxblAmtA", Nz(Round(DSum("TaxableValue", "QryJsonPos001", "[ItemSoldID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'A'"), 4), 0)

 

[Minty]

Colin has done soe extensive testing on query speeds - this one is specifically on DCount() but it demonstrates that it isn't intrinsically slow.

https://isladogs.co.uk/speed-comparison-tests-7/index.html

You may be getting confused by the advice to never use a domain function within a query unless absolutely necessary, that's a whole different story.
Adding additional parameters to a DLookup() shouldn't make any real difference to it's performance if the fields are indexed.

 

[The_Doc_Man]

DCount and DLookup would be unlikely to be slow, since they are inherently single-valued, looking at either the property or a single value in the recordset. DSUM, DMAX, DMIN, etc. have to look at all records in the domain. Hope it isn't too big a domain.

 

[RonPaii]

Single calls to domain functions for forms or reports are ok, but this in in a loop, and and noting a noticeable delay.

 

[nector]

Many thanks to all the contributors and you corrected me in many areas where I was getting confused.