Как увеличить количество обработанных строк в данных Json Compiled

Question

Приведенный ниже код слишком медленный при компиляции данных json и может компилировать только 12 строк.

Приведенный ниже код не может скомпилировать более 12 строк для данных в формате json с использованием приведенного ниже кода VBA и егослишком медленный

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

Мы хотим, чтобы помощь ускорилась, и нужно обработать как минимум 40 строк, в противном случае для точки продаж это будет кошмар.

Answer 1

Я неправильно использовал непосредственное окно, у него короткая память, единственный способ напечатать дополнительную строку - отправить его в файл.