Отправка и получение данных от и до 232 рупий в Ms Access VBA

Question

Я не могу отправлять и получать данные с и на RS 232 в моем простом приложении Ms Access с использованием VBA / Json

Здесь необходимо отправить отформатированные данные json на RS 232 вMs получает доступ к VBA, а также одновременно получает ответ

Dim intPortID As Integer                         ' Ex. 1, 2, 3, 4 for COM1 - COM4
Dim lngStatus As Long
Dim strError  As String
Dim strData   As String


' Initialize Communications
lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), _
                     "baud=9600 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.
lngSize = Len(strData)
lngStatus = CommWrite(intPortID, strData)
If lngStatus <> lngSize Then
    ' Handle error.
End If



' Read maximum of 64 bytes from serial port.
lngStatus = CommRead(intPortID, strData, 64)
If lngStatus > 0 Then
    ' Process data.
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)

Private Sub CmdSales_Click()

    '  Const SQL_SELECT As String = "SELECT * FROM Qry3;"

    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("Qry4")
    For Each prm In qdf.Parameters
        prm = Eval(prm.Name)
    Next prm
    Set rs = qdf.OpenRecordset()

    Set qdf = Nothing
    rs.MoveFirst
    Do While Not rs.EOF
        Set transaction = New Dictionary
        transaction.Add "PosSerialNumber", DLookup("PosSerialNumber", "tblInvoice", "Inv =" & Me.INV)
        transaction.Add "IssueTime", DLookup("IssueTime", "tblInvoice", "Inv =" & Me.INV)
        transaction.Add "Customer", Me.Customer.Column(1)
        transaction.Add "TransactionTyp", 0
        transaction.Add "PaymentMode", 0
        transaction.Add "SaleType", 0

        '--- loop over all the items
        Dim itemCount As Long
        itemCount = Me.txtInvoiceCount
        Set items = New Collection
        For i = 1 To itemCount
            Set item = New Dictionary
            item.Add "ItemID", i
            item.Add "Description", DLookup("Description", "Qry4", "Inv =" & Me.INV & " AND ItemesID =" & CStr(i))
            item.Add "BarCode", DLookup("BarCode", "Qry4", "Inv =" & Me.INV & " AND ItemesID =" & CStr(i))
            item.Add "Quantity", DLookup("Qty", "Qry4", "Inv =" & Me.INV & " AND ItemesID =" & CStr(i))
            item.Add "UnitPrice", DLookup("unitPrice", "Qry4", "Inv =" & Me.INV & " AND ItemesID =" & CStr(i))
            item.Add "Discount", DLookup("Discount", "Qry4", "Inv =" & Me.INV & " AND ItemesID =" & CStr(i))
            '--- loop over all the taxes
            Dim taxCount As Long
            taxCount = 1
            Set tax = New Collection

            '--- 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("Taxables", "Qry4", "Inv =" & Me.INV & " AND ItemesID =" & CStr(i))

                item.Add "Total", DLookup("TotalAmount", "Qry4", "Inv =" & Me.INV & " AND ItemesID =" & CStr(i))
                item.Add "IsTaxInclusive", DLookup("Inclusive", "Qry4", "Inv =" & Me.INV & " AND ItemesID =" & CStr(i))
                item.Add "RRP", DLookup("RRP", "Qry4", "Inv =" & Me.INV & " 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
    json = JsonConverter.ConvertToJson(transaction, Whitespace:=3)
Debug.Print json

End Sub

Private Sub CmdEmp_Click()
    Dim http As Object
    Dim json As Object
    Dim i As Integer
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim item As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Contact")
    http.Open "GET", "http://jsonplaceholder.typicode.com/users/?id=" & Me.txtUserID, False
    http.send
    Set json = ParseJson(http.responseText)
    i = 2
    For Each item In json

        With rs
            .AddNew
            ![ID] = item("id")
            ![firstName] = item("name")
            ![UserName] = item("username")
            ![Email] = item("email")
            ![street] = item("address")("street")
            ![suite] = item("address")("suite")
            ![city] = item("address")("city")
            ![zipcode] = item("address")("zipcode")
            ![lat] = item("address")("geo")("lat")
            ![lng] = item("address")("geo")("lng")
            ![Phone] = item("phone")
            ![WebSite] = item("website")
            ![Company] = item("company")("name")
            ![catchPhrase] = item("company")("catchPhrase")
            ![bs] = item("company")("bs")
            .Update
        End With
        i = i + 1
    Next
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Set json = Nothing
    Set http = Nothing

    MsgBox "Please note that your http run is complete check for new data in table called contact", vbExclamation, "Welcome to http hub"

End Sub