0

The current code below is too slow in compiling the the json data and can can only compile 12 lines.

The code below cannot compile more than 12 line for json formatted data using the VBA code below and its too slow

Private Sub CmdConertJson_Click()
'  Const SQL_SELECT As String = "SELECT * FROM QryJson;"

  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
  Dim root As Dictionary
    Set root = New Dictionary

    Dim transaction As Dictionary
    Dim transactions As Collection
    Dim item As Dictionary
    Dim items As Collection
    Dim invoice As Dictionary
    Dim invoices As Collection
    Dim Tax As Collection
    Dim i As Long
    Dim j As Long
    Dim t As Long
    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(dbOpenDynaset, dbSeeChanges)

Set qdf = Nothing
 rs.MoveFirst
    Do While Not rs.EOF
        Set transaction = New Dictionary
        transaction.Add "PosSerialNumber", Me.CboEfds.Column(1)
        transaction.Add "IssueTime", Me.txtjsonDate
        transaction.Add "TransactionTyp", Me.TransactionType
        transaction.Add "PaymentMode", Me.PaymentMode
        transaction.Add "SaleType", Me.SalesType
        transaction.Add "LocalPurchaseOrder", Me.LocalPurchaseOrder
        transaction.Add "Cashier", Me.Cashier
        transaction.Add "BuyerTPIN", Me.BuyerTPIN
        transaction.Add "BuyerName", Me.BuyerName
        transaction.Add "BuyerTaxAccountName", Me.BuyerTaxAccountName
        transaction.Add "BuyerAddress", Me.BuyerAddress
        transaction.Add "BuyerTel", Me.BuyerTel
        transaction.Add "OriginalInvoiceCode", Me.OrignalInvoiceCode
        transaction.Add "OriginalInvoiceNumber", Me.OrignalInvoiceNumber

        '--- loop over all the items
        Dim itemCount As Long
        itemCount = Me.txtsquence
        Set items = New Collection
        For i = 1 To itemCount
            Set item = New Dictionary
            item.Add "ItemID", i
            item.Add "Description", DLookup("ProductName", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            item.Add "BarCode", DLookup("ProductID", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            item.Add "Quantity", DLookup("Quantity", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            item.Add "UnitPrice", DLookup("unitPrice", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            item.Add "Discount", DLookup("Discount", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            '--- loop over all the taxes
            Dim taxCount As Long
            taxCount = 1
            Set Tax = New Collection
            Dim strTaxes As Boolean
            strTaxes = DLookup("CGControl", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            '--- loop over all the invoices
            Dim invoiceCount As Long
            invoiceCount = 1
            Set invoices = New Collection
            For j = 1 To invoiceCount

                For t = 1 To taxCount
            Next t
            item.Add "Taxable", Tax

            Tax.Add DLookup("TaxClassA", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            Tax.Add DLookup("TaxClassB", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))

                item.Add "Total", DLookup("TotalAmount", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
                item.Add "IsTaxInclusive", strTaxes
                item.Add "RRP", DLookup("RRP", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))

            Next j


            items.Add item
        Next i
        transaction.Add "Items", items

        rs.MoveNext
    Loop

    root.Add "", transaction

    Dim json As String
    Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4
    Dim lngStatus As Long
    Dim strError  As String
    Dim strData   As String
    Dim strDataToSend As String
    Dim lngSize As Long
    ' Initialize Communications
    lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), _
        "baud=115200 parity=N data=8 stop=1")

    If lngStatus <> 0 Then
    ' Handle error.
        lngStatus = CommGetError(strError)
    MsgBox "COM Error: " & strError
    End If


    ' Set modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, True)
    lngStatus = CommSetLine(intPortID, LINE_DTR, True)

    ' Write data to serial port.
    strDataToSend = JsonConverter.ConvertToJson(transaction, Whitespace:=3)
    lngSize = Len(strData)
    lngStatus = CommWrite(intPortID, strDataToSend)
    If lngStatus <> lngSize Then
    ' Handle error.
    End If
Call CmdReadWrite_Click
End Sub

We want help to increase speedy and at-least 40 lines need to be processed other for a point of sales it will be a nightmare.

Erik A
  • 31,639
  • 12
  • 42
  • 67
nector
  • 43
  • 8
  • Questions like this aren't a good fit for Stack Overflow. Note that `DLookUp` is a slow operation, and should probably be replaced with a recordset operation. – Erik A Oct 26 '19 at 14:48
  • Since Erik you have suggested to use the recordset in this case I have a query called QryJson, then how do I replace the Dlookup with WHERE clause here : DLookup("ProductName", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i)) – nector Oct 26 '19 at 18:00
  • See [How do I use parameters in VBA in the different contexts in Microsoft Access?](https://stackoverflow.com/a/49509616/7296893), the _Using DAO_ section, to do it properly. Note that you can use a single recordset to replace all your lookups. – Erik A Oct 26 '19 at 18:06

1 Answers1

0

I was wrong to use the immediate window , this has a short memory , the only way to print more line is to send it to file.

nector
  • 43
  • 8