Solved Just seeking an independent check on line counting and referencing in MS Access VBA

N

nector

Member
Local time
Today, 12:59
Joined
Jan 21, 2020
Messages
453
The goal here is to ensure that the sorted line items in Ms Access query attached in PDF format are picked exactly as they appear in a proper ascending order query so that the Json code send them to the virtual computer (invisible) exactly.

The start point is to count the item lines like below :

Code: 
'--- loop over all the items
        itemCount = Me.txtinternalaudit
    IIf(IsError(DCount("ItemesID","tblLineDetails","InvoiceID =" & [txtJsonReceived])),0,DCount("ItemesID","tblLineDetails","InvoiceID =" & [txtJsonReceived]))

Now after counting the lines and pasting the total count into the control called Me.txtinternalaudit , then that control become part of the reference in the main code below together with invoice number being referenced as Me.txtJsonReceived. So in short the code below is concatenate the two references.

Me.txtinternalaudit is converted into itemCount , then into i , see below:

Main code below

Code: 
'--- 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("BuyerSupply", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)
            item.Add "splyAmt", Nz(Round(DLookup("SellerAmount", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)
            item.Add "dcRt", Nz(Round(DLookup("Discount", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)
            item.Add "dcAmt", Nz(Round(DLookup("Discamount", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)
            item.Add "isrccCd", ""
            item.Add "isrccNm", ""
            item.Add "isrcRt", 0
            item.Add "isrcAmt", 0
            item.Add "vatCatCd", IIf((rs!TaxClassA.Value = ""), Null, rs!TaxClassA.Value)
            item.Add "iplCatCd", Null
            item.Add "tlCatCd", IIf((rs!AuditTourClass.Value <> ""), "TL", Null)
            item.Add "exciseCatCd", Null
            item.Add "vatTaxblAmt", Nz(Round(DLookup("Taxable", "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("SellerAmount", "QryJson", "[InvoiceID] =" & Me.txtJsonReceived & "And ItemesID =" & CStr(i)), 4), 0)

Problems

The problem here is that, sometimes the code pick only one product throughout instead of item by item, sometimes it works okay it will pick specific item line by line as per representation by the MS Access query

Any idea how to correct the problem here?
 

Attachments

Do you have warnings disabled? One possibility is that the code encounters an error.

We also cannot see the tail end of that sequence that would show the end of the FOR loop.

Finally, can you show us brief samples of both good AND BAD results?
 
Okay thanks I will have to switch on the error handling , its off

The good Json is below


Code: 
{
   "tpin": "1002623668",
   "bhfId": "000",
   "cisInvcNo": "CIS001-0002950",
   "orgInvcNo": 0,
   "custTpin": "1002623668",
   "prcOrdCd": 0,
   "custNm": "SAMPLE CASH SALES",
   "salesTyCd": "N",
   "rcptTyCd": "S",
   "pmtTyCd": "04",
   "salesSttsCd": "02",
   "cfmDt": "20240603074435",
   "salesDt": "20240603",
   "stockRlsDt": "20240603074435",
   "cnclReqDt": null,
   "cnclDt": null,
   "rfdDt": null,
   "rfdRsnCd": null,
   "totItemCnt": 3,
   "taxblAmtA": 0,
   "taxblAmtB": 465.5172,
   "taxblAmtC": 0,
   "taxblAmtC1": 0,
   "taxblAmtC2": 0,
   "taxblAmtC3": 392,
   "taxblAmtD": 540,
   "taxblAmtRvat": 0,
   "taxblAmtE": 0,
   "taxblAmtF": 0,
   "taxblAmtIpl1": 0,
   "taxblAmtIpl2": 0,
   "taxblAmtTl": 0,
   "taxblAmtEcm": 0,
   "taxblAmtExeeg": 0,
   "taxblAmtTot": 0,
   "taxRtA": 16,
   "taxRtB": 16,
   "taxRtC1": 0,
   "taxRtC2": 0,
   "taxRtC3": 0,
   "taxRtD": 0,
   "taxRtE": 0,
   "taxRtF": 10,
   "taxRtIpl1": 5,
   "taxRtIpl2": 0,
   "taxRtTl": 1.5,
   "taxRtEcm": 5,
   "taxRtExeeg": 3,
   "taxRtTot": 0,
   "taxRtRvat": 16,
   "taxAmtA": 0,
   "taxAmtB": 74.4828,
   "taxAmtC1": 0,
   "taxAmtC2": 0,
   "taxAmtC3": 0,
   "taxAmtD": 0,
   "taxAmtC": 0,
   "tlAmt": 0,
   "taxAmtE": 0,
   "taxAmtF": 0,
   "taxAmtIpl1": 0,
   "taxAmtIpl2": 0,
   "taxAmtTl": 0,
   "taxAmtEcm": 0,
   "taxAmtExeeg": 0,
   "taxAmtTot": 0,
   "taxAmtRvat": 0,
   "totTaxblAmt": 1397.5172,
   "totTaxAmt": 74.4828,
   "totAmt": 1472,
   "prchrAcptcYn": "N",
   "remark": null,
   "regrId": "11999",
   "regrNm": "Admin Manager",
   "modrId": "45678",
   "modrNm": "Admin Manager",
   "saleCtyCd": "1",
   "lpoNumber": null,
   "currencyTyCd": "ZMW",
   "exchangeRt": "1",
   "destnCountryCd": "",
   "dbtRsnCd": "",
   "invcAdjustReason": "",
   "itemList": [
      {
         "itemSeq": 1,
         "itemCd": "ZM2NTU00000014",
         "itemClsCd": "40000014",
         "itemNm": "CEMENT",
         "bcd": null,
         "pkgUnitCd": "NT",
         "pkg": 1,
         "qtyUnitCd": "U",
         "qty": 3,
         "prc": 180,
         "splyAmt": 540,
         "dcRt": 0,
         "dcAmt": 0,
         "isrccCd": "",
         "isrccNm": "",
         "isrcRt": 0,
         "isrcAmt": 0,
         "vatCatCd": "B",
         "iplCatCd": null,
         "tlCatCd": null,
         "exciseCatCd": null,
         "vatTaxblAmt": 465.5172,
         "vatAmt": 74.4828,
         "exciseTaxblAmt": 0,
         "tlTaxblAmt": 0,
         "iplTaxblAmt": 0,
         "iplAmt": 0,
         "tlAmt": 0,
         "exciseTxAmt": 0,
         "totAmt": 540
      },
      {
         "itemSeq": 2,
         "itemCd": "ZMNTU00000032",
         "itemClsCd": "40000032",
         "itemNm": "FRESH MILK 500 MLS",
         "bcd": null,
         "pkgUnitCd": "NT",
         "pkg": 1,
         "qtyUnitCd": "U",
         "qty": 7,
         "prc": 56,
         "splyAmt": 392,
         "dcRt": 0,
         "dcAmt": 0,
         "isrccCd": "",
         "isrccNm": "",
         "isrcRt": 0,
         "isrcAmt": 0,
         "vatCatCd": "C3",
         "iplCatCd": null,
         "tlCatCd": null,
         "exciseCatCd": null,
         "vatTaxblAmt": 392,
         "vatAmt": 0,
         "exciseTaxblAmt": 0,
         "tlTaxblAmt": 0,
         "iplTaxblAmt": 0,
         "iplAmt": 0,
         "tlAmt": 0,
         "exciseTxAmt": 0,
         "totAmt": 392
      },
      {
         "itemSeq": 3,
         "itemCd": "ZMNTU00000033",
         "itemClsCd": "40000033",
         "itemNm": "INFANT POWDER MILK",
         "bcd": null,
         "pkgUnitCd": "NT",
         "pkg": 1,
         "qtyUnitCd": "U",
         "qty": 4,
         "prc": 135,
         "splyAmt": 540,
         "dcRt": 0,
         "dcAmt": 0,
         "isrccCd": "",
         "isrccNm": "",
         "isrcRt": 0,
         "isrcAmt": 0,
         "vatCatCd": "D",
         "iplCatCd": null,
         "tlCatCd": null,
         "exciseCatCd": null,
         "vatTaxblAmt": 540,
         "vatAmt": 0,
         "exciseTaxblAmt": 0,
         "tlTaxblAmt": 0,
         "iplTaxblAmt": 0,
         "iplAmt": 0,
         "tlAmt": 0,
         "exciseTxAmt": 0,
         "totAmt": 540
      }
   ]
}

For now I do not have a bad json
 
Is there a reason to slow down the execution intentionally with the many lookups? ;)

Just as an idea:
Code: 
Private Sub YourInvoiceDoSomethingProcedure(Byval InvoiceID As Long)

   ... (init Transactions object & Co.)

   Dim JsonDataRs As DAO.Recordset
   Dim JsonDataSql As String
   Dim InvoiceItemJsonDict As Dictionary

   JsonDataSql = "select * from QryJson where [InvoiceID]=" & InvoiceID & " Order By ItemesID"
   Set JsonDataRs = CurrentDb.OpenRecordset(JsonDataSql, dbOpenForwardOnly)
   With JsonDataRs
      Do While Not .EOF
         Set InvoiceItemJsonDict = GetJsonInvoiceItemDictFromRecord(JsonDataRs)
         Transactions.Add InvoiceItemJsonDict
         .MoveNext
      Loop
      .Close
   End With
   Set JsonDataRs = Nothing

   ... (do something with Transactions, ...)

End Sub

Private Function GetJsonInvoiceItemDictFromRecord(ByVal JsonDataRs As DAO.Recordset) As Dictionary

   Dim Item As Dictionary

   Set Item = New Dictionary
   Item.Add "itemSeq", JsonDataRs.Fields("ItemesID").Value ' Is ItemesID really the itemSeq?
   Item.Add "itemCd", JsonDataRs.Fields("itemCd").Value
   Item.Add "itemClsCd", JsonDataRs.Fields("itemClsCd").Value
   Item.Add "itemNm", JsonDataRs.Fields("ProductName").Value
   ...

   Set GetJsonInvoiceItemDictFromRecord = Item

End Function

BTW:
I would design a query that has the names of the json fields as field names and performs the rounding. Then I could run through the fields in a loop instead of many lines of code.
=>
Code: 
Private Sub YourInvoiceDoSomethingProcedure(Byval InvoiceID As Long)
...
     JsonDataSql = "select ItemesID as itemSeq, itemClsCd, ... from QryJson where [InvoiceID]=" & InvoiceID & " Order By ItemesID"
     ' .. only write the fields that should end up in the json into the select statement.
...
End Sub

Private Function GetJsonInvoiceItemDictFromRecord(ByVal JsonDataRs As DAO.Recordset) As Dictionary

   Dim Item As Dictionary
   Set Item = New Dictionary

   Dim fld As DAO.Field
   For Each fld In JsonDataRs.Fields
      Item.Add fld.Name, fld.Value
   Next

   Set GetJsonInvoiceItemDictFromRecord = Item

End Function
 
Last edited:
Hi Josef P

My question is all about accuracy not the speed, did you find any issues with the code in terms of accuracy processing?

Best Regards
 
My question is all about accuracy not the speed, ...
Click to expand...
We already had this topic, didn't we?
Sum(Round([NetValue] * Tax), 4) vs. Round(Sum([NetValue]) * Tax, 4)
It doesn't have to be the same.

Just for thought (this has nothing to do with Json):
Code: 
Const NetValue As Double = 1.234
Const TaxRate as Double = 0.17
Const ItemCount As Long = 4

Dim TotalNotRounded As Double
Dim TotalRoundV1 As Double
Dim TotalRoundV2 As Double

TotalNotRounded = ItemCount * NetValue * TaxRate
TotalRoundV1 = ItemCount * Round(NetValue * TaxRate, 4)
TotalRoundV2 = Round(ItemCount * NetValue * TaxRate, 4)

Debug.Print TotalRoundV1, TotalRoundV2, TotalNotRounded
 
Last edited:
We already had this topic, didn't we?
Sum(Round([NetValue] * Tax), 4) vs. Round(Sum([NetValue]) * Tax, 4)
It doesn't have to be the same.


The double being suggested here is very poor in terms of handling financial data, the correct and accuracy way is to use currency data type
 
Double or currency is irrelevant for the example. This is simple maths.

Code: 
Const NetValue As Currency = 1.234
Const TaxRate As Currency = 0.17
Const ItemCount As Currency = 4

Dim TotalNotRoundedV1 As Currency
Dim TotalNotRoundedV2 As Currency
Dim TotalRoundV1 As Currency
Dim TotalRoundV2 As Currency

TotalNotRoundedV1 = ItemCount * (NetValue * TaxRate)  '<--- with Currency ~equal to ItemCount * Round(NetValue * TaxRate, 4)
TotalNotRoundedV2 = (ItemCount * NetValue) * TaxRate  '<--- with Currency ~equal to Round(ItemCount * NetValue * TaxRate, 4)
TotalRoundV1 = ItemCount * Round(NetValue * TaxRate, 4)
TotalRoundV2 = Round(ItemCount * NetValue * TaxRate, 4)

Debug.Print TotalRoundV1, TotalRoundV2, TotalNotRoundedV1, TotalNotRoundedV2
 
Last edited:
You must log in or register to reply here.

Similar threads

N
VBA Code error on the counter
Replies
5
Views
171
cheekybuddha
cheekybuddha
N
Solved Progress meter for reports & queries in MS Access
Replies
16
Views
714
tvanstiphout
T
N
Solved Caching recordset in MS Access VBA
2
Replies
26
Views
1,646
tvanstiphout
T
N
Solved Big variation when sending data through Cloud SQL Server Vs MS Access
Replies
10
Views
628
Pat Hartman
P
N
Solved How to grab fields from Json string to be part of the invoice
Replies
14
Views
748
Edgar_
E

Users who are viewing this thread

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