How to replace the domain function in MS Access VBA

N

nector

Member
Local time
Today, 04:16
Joined
Jan 21, 2020
Messages
601
I want to replace the domain functions in my MS Access project in order to improve the speed, but I seem to be failing, I have tried to use AI still waste it was retuning zero result, however the code below work very well with the domain functions any help out there will be highly appreciated.

Code: 
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("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 While Not rs.EOF
Set data = New Dictionary
Set transactions = New Collection
Set Company = New Dictionary
        Company.Add "tpin", Forms!FrmLogin!txtsuptpin.Value
        Company.Add "bhfId", Forms!FrmLogin!txtbhfid.Value
        Company.Add "cisInvcNo", rs!cisInvcNo.Value
        Company.Add "orgInvcNo", Nz(rs!OrignalInvoiceNumber.Value, 0)
        Company.Add "orgSdcId", Forms!FrmLogin!txtDeviceSerialNumber.Value
        Company.Add "custTpin", rs!TPIN.Value
        Company.Add "prcOrdCd", 0
        Company.Add "custNm", rs!Company.Value
        Company.Add "salesTyCd", rs!SalesType.Value
        Company.Add "rcptTyCd", IIf((rs!DocCodes.Value = Null), "D", rs!DocCodes.Value)
        Company.Add "pmtTyCd", rs!PaymentIDs.Value
        Company.Add "salesSttsCd", "02"
        Company.Add "cfmDt", rs!ActualDate.Value
        Company.Add "salesDt", Format((rs!ShipDate), "yyyymmdd")
        Company.Add "stockRlsDt", IIf(Len(rs!stockreleasing.Value), rs!stockreleasing.Value, Null)
        Company.Add "cnclReqDt", Null
        Company.Add "cnclDt", Null
        Company.Add "rfdDt", Null
        Company.Add "rfdRsnCd", rs!rfdRsnCd.Value
        Company.Add "totItemCnt", Me.txtinternalaudit
        Company.Add "taxblAmtA", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'A'"), 4), 0)
        Company.Add "taxblAmtB", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'B'"), 4), 0)
        Company.Add "taxblAmtC", 0
        Company.Add "taxblAmtC1", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'C1'"), 4), 0)
        Company.Add "taxblAmtC2", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'C2'"), 4), 0)
        Company.Add "taxblAmtC3", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.CboEsdInvoices & "And [TaxClassA] = 'C3'"), 4), 0)
        Company.Add "taxblAmtD", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'D'"), 4), 0)
        Company.Add "taxblAmtRvat", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'RVAT'"), 4), 0)
        Company.Add "taxblAmtE", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'E'"), 4), 0)
        Company.Add "taxblAmtF", 0
        Company.Add "taxblAmtIpl1", 0
        Company.Add "taxblAmtIpl2", 0
        Company.Add "taxblAmtTl", Nz(Round(DSum("TLTaxable", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TourismClass] = 'TL'"), 4), 0)
        Company.Add "taxblAmtEcm", 0
        Company.Add "taxblAmtExeeg", 0
        Company.Add "taxblAmtTot", 0
        Company.Add "taxRtA", 16
        Company.Add "taxRtB", 16
        Company.Add "taxRtC1", 0
        Company.Add "taxRtC2", 0
        Company.Add "taxRtC3", 0
        Company.Add "taxRtD", 0
        Company.Add "taxRtE", 0
        Company.Add "taxRtF", 10
        Company.Add "taxRtIpl1", 5
        Company.Add "taxRtIpl2", 0
        Company.Add "taxRtTl", 1.5
        Company.Add "taxRtEcm", 5
        Company.Add "taxRtExeeg", 3
        Company.Add "taxRtTot", 0
        Company.Add "taxRtRvat", 16
        Company.Add "taxAmtA", Nz(Round(DSum("TaxAmount", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'A'"), 4), 0)
        Company.Add "taxAmtB", Nz(Round(DSum("TaxAmount", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'B'"), 4), 0)
        Company.Add "taxAmtC1", 0
        Company.Add "taxAmtC2", 0
        Company.Add "taxAmtC3", 0
        Company.Add "taxAmtD", 0
        Company.Add "taxAmtC", 0
        Company.Add "tlAmt", 0
        Company.Add "taxAmtE", 0
        Company.Add "taxAmtF", 0
        Company.Add "taxAmtIpl1", 0
        Company.Add "taxAmtIpl2", 0
        Company.Add "taxAmtTl", Nz(Round(DSum("TLLevyTax", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TourismClass] = 'TL'"), 4), 0)
        Company.Add "taxAmtEcm", 0
        Company.Add "taxAmtExeeg", 0
        Company.Add "taxAmtTot", 0
        Company.Add "taxAmtRvat", Nz(Round(DSum("FinalTax", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'RVAT'"), 4), 0)
        Company.Add "totTaxblAmt", Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived), 4)
        Company.Add "totTaxAmt", Round(DSum("TaxAmount", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived), 4) + Nz(Round(DSum("TLLevyTax", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TourismClass] = 'TL'"), 4), 0)
        Company.Add "totAmt", DSum("ActualPricing", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived) + Nz(Round(DSum("Taxable", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TurnoverClass] = 'TOT'"), 4), 0)
        Company.Add "prchrAcptcYn", "N"
        Company.Add "remark", rs!TheNotes.Value
        Company.Add "regrId", Forms!FrmLogin!txtpersoning.Value
        Company.Add "regrNm", Forms!FrmLogin!txtpersoning.Value
        Company.Add "modrId", Forms!FrmLogin!txtpersoning.Value
        Company.Add "modrNm", Forms!FrmLogin!txtpersoning.Value
        Company.Add "saleCtyCd", "1"
        Company.Add "lpoNumber", rs!LocalPurchaseOrder.Value
        Company.Add "currencyTyCd", rs!Moneytype.Value
        Company.Add "exchangeRt", rs!FCRate.Value
        Company.Add "destnCountryCd", IIf((rs!CountryDestination.Value = Null), "", rs!CountryDestination.Value)
        Company.Add "dbtRsnCd", rs!DebitNoteReason.Value
        Company.Add "nvcAdjustReason", rs!TheNotes.Value
        Company.Add "itemList", transactions
             
    '--- loop over all the items
        itemCount = Me.txtinternalaudit
       
        For i = 1 To itemCount
            Set item = New Dictionary
            transactions.Add item
            item.Add "itemSeq", i
            item.Add "itemCd", DLookup("itemCd", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i))
            item.Add "itemClsCd", DLookup("itemClsCd", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i))
            item.Add "itemNm", DLookup("ProductName", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i))
            item.Add "bcd", Null
            item.Add "pkgUnitCd", "NT"
            item.Add "pkg", 1
            item.Add "qtyUnitCd", "U"
            item.Add "qty", Nz(Round(DLookup("Qty", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)
            item.Add "prc", Nz(Round(DLookup("UnitPrice", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)
            item.Add "rrp", Nz(Round(DLookup("RRP", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)
            item.Add "splyAmt", Nz(Round(DLookup("FinalPricings", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)
            item.Add "dcRt", 0
            item.Add "dcAmt", 0
            item.Add "isrccCd", ""
            item.Add "isrccNm", ""
            item.Add "isrcRt", 0
            item.Add "isrcAmt", 0
            item.Add "vatCatCd", DLookup("TaxClassA", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i))
            item.Add "iplCatCd", Null
            item.Add "tlCatCd", IIf((rs!TourismClass.Value <> ""), "TL", Null)
            item.Add "exciseCatCd", Null
            item.Add "vatTaxblAmt", Nz(Round(DLookup("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)
            item.Add "vatAmt", Nz(Round(DLookup("TaxAmount", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)
            item.Add "exciseTaxblAmt", 0
            item.Add "tlTaxblAmt", Nz(Round(DLookup("TLTaxable", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)
            item.Add "iplTaxblAmt", 0
            item.Add "iplAmt", 0
            item.Add "tlAmt", Nz(Round(DLookup("TLLevyTax", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)
            item.Add "exciseTxAmt", 0
            item.Add "totAmt", Nz(Round(DLookup("ActualPricing", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)

strData = JsonConverter.ConvertToJson(Company, Whitespace:=3)
rs.MoveNext
Next
Loop
 
Make a new aggregate query that sums all of those values. Open it and assign a bunch of variables to those values that currently use drum. Open qyjson as recordet with your where condition. Save all those dlookups as variables. Use your variables.
 
That opens only 2 recordsets. You are opening a recordset with each domain.
 
Each of those DSum calls has different filter criteria. How would you expect to accomplish this with a single recordset?

However, DLookup calls appear to use same criteria and a single recordset could be used. (Why aren't you referencing already open recordset? Should this recordset have filter criteria?)

Also, I don't see how any of these domain aggregate calls can work. They should all fail due to lack of space preceding "And" in concatenation.

Is "ItemesID" field name really spelled with second "e"?
 
Last edited:
Each of those DSum calls has different filter criteria.
Click to expand...
@June7
Sorry was doing this on my phone and could not see. You can still get it down to a 2 or 3 recordsets.
For the dlookup, it should be simple to do one.
Code: 
            Dim strSql As String
            Dim rs As DAO.Database
            'Define variables
            Dim ItemCD As Long
            '....
            Dim totAmt As Currency
            
            strSql = "Select * from qryJson where InvoiceID = " & Me.txtJsonReceived & "And ItemesID =" & CStr(i)
            Set rs = CurrentDb.OpenRecordset(strSql)
                      
            ItemCD = rs!ItemCD
            '...
            totAmt = Nz(Round(rs!ActualPricing, 4), 0)
            
            'add to dictionary
            Item.Add "itemCd", ItemCD
            Item.Add "totAmt", totAmt

I agree that people assume that Domain function are a huge performance issue. Yes, when used in a large query. But you are probably right. modifying save you probably a second or less.
 
In the DSUMS you can do this in one recordset for the majority.
Code: 
'        Company.Add "taxblAmtA", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'A'"), 4), 0)
'        Company.Add "taxblAmtB", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'B'"), 4), 0)
'        Company.Add "taxblAmtC1", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'C1'"), 4), 0)
'        Company.Add "taxblAmtC2", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'C2'"), 4), 0)
'        Company.Add "taxblAmtC3", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.CboEsdInvoices & "And [TaxClassA] = 'C3'"), 4), 0)
'        Company.Add "taxblAmtD", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'D'"), 4), 0)
'        Company.Add "taxblAmtE", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'E'"), 4), 0)
'        Company.Add "taxAmtA", Nz(Round(DSum("TaxAmount", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'A'"), 4), 0)
'        Company.Add "taxAmtB", Nz(Round(DSum("TaxAmount", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'B'"), 4), 0)
'        Company.Add "taxblAmtRvat", Nz(Round(DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'RVAT'"), 4), 0)
'        Company.Add "taxAmtRvat", Nz(Round(DSum("FinalTax", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'RVAT'"), 4), 0)

with
Code: 
 ' Create a query grouped by TaxClassA and invoiceID and sums taxablevalue, taxamount, finalTax. Call it qrySums
 
  Dim rs As DAO.Recordset
  Dim strSql As String
 
  strSql = "Select * from qrySums where [InvoiceID] = " & Me.txtJsonReceived
  Set rs = CurrentDb.OpenRecordset(strSql)
 
  If Not rs.EOF Then
    rs.FindFirst "[TaxClassA] = 'A'"
    If Not rs.NoMatch Then company.Add "taxblAmtA", Nz(Round(rs!taxableValue, 4), 0)
  
    ' ....
    rs.FindFirst "[TaxClassA] = 'RVAT'"
    If Not rs.NoMatch Then company.Add "taxAmtRvat", Nz(Round(rs!FinalTax, 4), 0)
  End
 
It looks like the the 8 "TaxableValue" queries could be handle by a records set and a cross tab query.
[TaxClassA] in A, B, C1, C2, C3, D, RVAT, E

Code: 
DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'A'")
DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'B'")
DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'C1'")
DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'C2'"),
DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.CboEsdInvoices & "And [TaxClassA] = 'C3'"
DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'D'")
DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'RVAT'")
DSum("TaxableValue", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And [TaxClassA] = 'E'")

The others may be speeded up with a helper function instead of dsum.

Code: 
public Function PSum(ByVal QueryString as string) as Variant
  With Currentdb.OpenRecordset(QueryString,dbOpenForwardOnly)
    If .RecordCount = 0 then
       PSum = Null
    Else
       Psum = .Fields(0)
    End If
  End With
End Function
 
You must log in or register to reply here.

Similar threads

N
Solved How get lid of domain function and replace them with opening recordset in MS Access VBA
Replies
10
Views
883
nector
N
N
How to send filtered transactions in the MS Access Combo box with one Click
Replies
15
Views
1,496
Mark_
M
N
VBA Code error on the counter
Replies
4
Views
971
cheekybuddha
cheekybuddha
N
Solved Just seeking an independent check on line counting and referencing in MS Access VBA
Replies
7
Views
962
Josef P.
J
N
Solved Progress meter for reports & queries in MS Access
Replies
16
Views
2,739
tvanstiphout
T

Users who are viewing this thread

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