json - VBA 编译问题

Question

我正在尝试重构我的 VBA 以使用下面的 VBA 从 Ms 访问发送和接收数据到 Rs 232 通信端口，但是在迭代 Json 数据之前在接收部分编译时出现错误，请看看我在哪里我出错了：

发送的第一部分似乎没问题，在 A 部分，问题在 B 部分。

补充资料：

A部分将原始数据格式化为Json，格式化后的Json数据发送到Rs 232 Comm端口，Value = 2

B节这应该是通过循环遍历将接收到的Json格式的数据读写到表中，这就是问题所在。请看看你能如何提供帮助。

要检查的 VBA 代码

Private Sub CmdConertJson_Click()
'  Const SQL_SELECT As String = "SELECT * FROM QryJson;"
  On Error GoTo Err_Handler
  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(dbOpenSnapshot, dbSeeChanges)

Set qdf = Nothing
 rs.MoveFirst
    Do While Not rs.EOF
        Set transaction = New Dictionary
        transaction.Add "PosVendor", "Nector Prime Accounting Solutions"
        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 lngSize As Long
    intPortID = 2
    ' 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.
    strData = JsonConverter.ConvertToJson(transaction, Whitespace:=3)
    lngSize = Len(strData)
    lngStatus = CommWrite(intPortID, strData)
    If lngStatus <> lngSize Then
    ' Handle error.
    End If

Exit_CmdConertJson_Click:
Exit Sub
Err_Handler:
Resume Exit_CmdConertJson_Click

'Section B
 ' Read maximum of 64 bytes from serial port.
    lngStatus = CommRead(intPortID, strData, 14400)
    If lngStatus > 0 Then
        ' Process data.

  Set db = CurrentDb
  Set rs = db.OpenRecordset("tblEfdReceipts")
  For Each item In strData
    rs.AddNew
            rs![TPIN] = item("TPIN")
            rs![TaxpayerName] = item("TaxpayerName")
            rs![Address] = item("Address")
            rs![ESDTime] = item("ESDTime")
            rs![TerminalID] = item("TerminalID")
            rs![InvoiceCode] = item("InvoiceCode")
            rs![InvoiceNumber] = item("InvoiceCode")
            rs![FiscalCode] = item("FiscalCode")
            rs![TalkTime] = item("TalkTime")
            rs![Operator] = item("Operator")
            rs![Taxlabel] = item("TaxItems")("TaxLabel")
            rs![CategoryName] = item("TaxItems")("CategoryName")
            rs![Rate] = item("TaxItems")("Rate")
            rs![TaxAmount] = item("TaxItems")("TaxAmount")
            rs![VerificationUrl] = item("TaxItems")("VerificationUrl")
            rs![INVID] = Me.InvoiceID
            rs.Update
  Next item

  rs.Close
  Set rs = Nothing
  Set db = Nothing

    ElseIf lngStatus < 0 Then
        ' Handle error.
    End If

    ' Reset modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, False)
    lngStatus = CommSetLine(intPortID, LINE_DTR, False)

    ' Close communications.
    Call CommClose(intPortID)
End Sub

这里的问题是我如何将接收到的 JSON 数据放入一个对象中，以便我可以对其进行迭代并将其数据更新到名为 tblEfdReceipts 的表中

我已关注您的评论，请检查这是否是您说我需要放入对象时的意思：

修订的 VBA 代码

Private Sub CmdConertJson_Click()
  On Error GoTo Err_Handler
  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 Z As Integer
    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(dbOpenSnapshot, dbSeeChanges)

Set qdf = Nothing
 rs.MoveFirst
    Do While Not rs.EOF
        Set transaction = New Dictionary
        transaction.Add "PosVendor", "Nector Prime Accounting Solutions"
        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 lngSize As Long
    intPortID = 2
    ' 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.
    strData = JsonConverter.ConvertToJson(transaction, Whitespace:=3)
    lngSize = Len(strData)
    lngStatus = CommWrite(intPortID, strData)
    If lngStatus <> lngSize Then
    ' Handle error.
    End If
Exit_CmdConertJson_Click:
Exit Sub
Err_Handler:
Resume Exit_CmdConertJson_Click

' Read maximum of 64 bytes from serial port.

Dim JSONS As Object

    lngStatus = CommRead(intPortID, strData, 14400)

Set rs = db.OpenRecordset("tblEfdReceipts")
    If lngStatus > 0 Then
    ElseIf lngStatus < 0 Then
        ' Handle error.
        On Error Resume Next
    End If
        ' Process data.
  Set JSONS = JsonConverter.ParseJson(strData)
    Z = 2
  For Each item In JSONS
           With rs

            .AddNew
            rs![TPIN] = item("TPIN")
            rs![TaxpayerName] = item("TaxpayerName")
            rs![Address] = item("Address")
            rs![ESDTime] = item("ESDTime")
            rs![TerminalID] = item("TerminalID")
            rs![InvoiceCode] = item("InvoiceCode")
            rs![InvoiceNumber] = item("InvoiceCode")
            rs![FiscalCode] = item("FiscalCode")
            rs![TalkTime] = item("TalkTime")
            rs![Operator] = item("Operator")
            rs![Taxlabel] = item("TaxItems")("TaxLabel")
            rs![CategoryName] = item("TaxItems")("CategoryName")
            rs![Rate] = item("TaxItems")("Rate")
            rs![TaxAmount] = item("TaxItems")("TaxAmount")
            rs![VerificationUrl] = item("TaxItems")("VerificationUrl")
            rs![INVID] = Me.InvoiceID
            rs.Update
        End With
        Z = Z + 1
    Next

      rs.Close
      Set rs = Nothing
      Set db = Nothing
      Set JSONS = Nothing

    ' Reset modem control lines.
    lngStatus = CommSetLine(intPortID, LINE_RTS, False)
    lngStatus = CommSetLine(intPortID, LINE_DTR, False)

    ' Close communications.
    Call CommClose(intPortID)

End Sub

标签： jsonvbams-access