We help IT Professionals succeed at work.
Get Started

Problems sending VBA formatted data to the serial port

265 Views
Last Modified: 2020-02-28
I have some issues concerning the sending of the correctly formatted Json data to the serial as per manual description below:
Manual Serial port sending details
All the data will be organized in JSON format starting with package header and ending with checksum. It consists of Header, Command ID, Length of data, Content and Verification Code (CRC):

String: <Header1><Header2><CmdID ><Length ><Content><CRC>

Field                                      Length (Byte)                                             Description

Header 1                              1                                                                   The first byte of package header 0x1A
Header 2                              1                                                                   The second byte of package header Ox5D
CmdID                                  1
                                                                                                                    Command IDs:
                                                                                                                    0x01 acquire the status of ESD
                                                                                                                    0x02 invoice signing
                                                                                                                    0x03 Error code
Length                                  4                                                                   The length of the content, big-endian
Content                               ?                                                                 The Json based business data
CRC                                       2                                                                   Two-Byte verification (CRC), it will be

generated by bytes start from
Header 1 up to content


Work Done Step by step

Step 1

(Header 1) 1 The first byte of package header 0x1A

Dim Header1 As String, DecimalValue As Integer, BinaryValue As String
DecimalValue = &H1A
BinaryValue = DecToBins(DecimalValue, 8)
Header1 = DecToBins(DecimalValue, 8)
MsgBox "Header1 :" & vbCrLf & Header1

Open in new window


This has now given me string like = 11111010

Step 2

Dim Header2 As String
DecimalValue = &H5D
BinaryValue = DecToBins(DecimalValue, 8)
Header2 = DecToBins(DecimalValue, 8)
MsgBox "Header2 :" & vbCrLf & Header2

Open in new window


This has now given me string like = 11011101

Step 3

Dim CmdID As String, CmdOne As String, Cmdtwo As String, Cmdthree As String
DecimalValue = &H1
BinaryValue = DecToBins(DecimalValue, 8)
CmdOne = DecToBins(DecimalValue, 8)
MsgBox "CmdOne :" & vbCrLf & CmdOne

Open in new window


This has now given me string like = 11111111

DecimalValue = &H2
BinaryValue = DecToBins(DecimalValue, 8)
Cmdtwo = DecToBins(DecimalValue, 8)
MsgBox "Cmdtwo :" & vbCrLf & Cmdtwo

Open in new window

This has now given me string like = 11111110

DecimalValue = &H3
BinaryValue = DecToBins(DecimalValue, 8)
Cmdthree = DecToBins(DecimalValue, 8)
MsgBox "Cmdthree :" & vbCrLf & Cmdthree

Open in new window


This has now given me string like = 11111111

Summary for (H1, H2 & H3)

CmdID = CmdOne & "><" & Cmdtwo & "><" & Cmdthree
MsgBox "CmdID :" & vbCrLf & CmdID

Open in new window

This has now given me string like = 11111111><11111110><11111111



Step 4

Dim length As String, LengthFinal As String

LengthFinal = Len(Trim(CStr(JsonConverter.ConvertToJson(transaction, Whitespace:=3))) & Chr$(13))
DecimalValue = LengthFinal
BinaryValue = DecToBinLength(DecimalValue, 8)
length = DecToBinLength(DecimalValue, 8)
MsgBox "length :" & vbCrLf & length

Open in new window

This has now given me string like = 01010111

Step 5

Dim Content As String, cont As String, fulldata As String
cont = Len(Trim(CStr(JsonConverter.ConvertToJson(transaction, Whitespace:=3))) & Chr$(13))
DecimalValue = cont
BinaryValue = DecToBinContent(DecimalValue, 8)
Content = DecToBinContent(DecimalValue, 8)
MsgBox "Content :" & vbCrLf & Content

Open in new window


This has now given me string like = 01010111

Step 5 (CRC)

fulldata = "<" & Header1 & "><" & Header2 & "><" & CmdID & "><" & length & "><" & Content & ">"
Dim data() As Byte
Dim CRCs As String
data = StrConv(fulldata, vbFromUnicode)
    CRCs = cal_crc(data, 10)
    MsgBox "CRCs :" & vbCrLf & CRCs
    
Dim crc As String
DecimalValue = Len(CRCs)
BinaryValue = DecToBincrc(DecimalValue, 8)
crc = DecToBincrc(DecimalValue, 8)
MsgBox "CRC :" & vbCrLf & crc

Open in new window

This has now given me string like = 11111101


Step 6 (Final String)


String: <Header1><Header2><CmdID ><Length ><Content><CRC>

Open in new window



strData = "<" & Header1 & "><" & Header2 & "><" & CmdID & "><" & length & "><" & Content & "><" & crc & ">"
MsgBox "strData :" & vbCrLf & strData

Open in new window



This has now given me string like
=(strData) <11111010><11011101><11111111><11111110><11111111><01010111>01010111><11111101>

Open in new window


Requirements its seams like this is the only code that is supposed to be sent to this serial gadget but it must accommodate the following:

"baud=115200 parity=N data=8 stop=1"

Open in new window


Question 1

How do I frame the VBA code to send (write to the port) the string as per below together with the required "baud=115200 parity=N data=8 stop=1"

=(strData) <11111010><11011101><11111111><11111110><11111111><01010111>01010111><11111101>

Question 2

The manual says receiving data from the gadget follows the same pattern, then how do I frame the VBA to receive (reading the data) the data from the gadget using the same string as below:

=(strData) <11111010><11011101><11111111><11111110><11111111><01010111>01010111><11111101>

Open in new window

Current status
I have tried to use the VBA code below it failed to work; please see how you can help.

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
    intPortID = Forms!frmLogin!txtFinComPort.Value
    ' 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)

lngSize = Len(strData)
    lngStatus = CommWrite(intPortID, strData)
    If lngStatus <> lngSize Then
    ' Handle error.
' Handle error.
        On Error Resume Next
    End If

Open in new window

‘Receing part of the VBA code

' Read maximum of 14400 bytes from serial port.

Dim Jsons As Dictionary
Set Jsons = New Dictionary
Dim itemiz As Dictionary
    lngStatus = CommRead(intPortID, strData, 14400)

Set rs = db.OpenRecordset("tblEfdReceiptsPOS")
    If lngStatus > 0 Then
    Set Jsons = JsonConverter.ParseJson(strData)
    Z = 2
    ElseIf lngStatus < 0 Then
    Beep
    MsgBox "Please note that there is no data to read", vbOKOnly, "The Comm Port has no data"
        ' Handle error.
        On Error Resume Next
    End If
        ' Process data.
    For Each itemiz In Jsons
            With rs
            .AddNew
            rs![TPIN] = item("TPIN")
            rs![TaxpayerName] = itemiz("TaxpayerName")
            rs![Address] = itemiz("Address")
            rs![ESDTime] = itemiz("ESDTime")
            rs![TerminalID] = itemiz("TerminalID")
            rs![InvoiceCode] = itemiz("InvoiceCode")
            rs![InvoiceNumber] = itemiz("InvoiceCode")
            rs![FiscalCode] = itemiz("FiscalCode")
            rs![TalkTime] = itemiz("TalkTime")
            rs![Operator] = itemiz("Operator")
            rs![Taxlabel] = itemiz("TaxItems")("TaxLabel")
            rs![CategoryName] = itemiz("TaxItems")("CategoryName")
            rs![Rate] = itemiz("TaxItems")("Rate")
            rs![TaxAmount] = item("TaxItems")("TaxAmount")
            rs![VerificationUrl] = itemiz("TaxItems")("VerificationUrl")
            rs![INVID] = Me.ItemSoldID
            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)

Open in new window


Miscellaneous

(1)      Could it be I misinterpreted the whole requirements, I have run out of ideas now.  
(2)      I also doubt strong the final potion of the vba code shown below I still think something is missing here:

Dim Jsons As Dictionary
Set Jsons = New Dictionary
Dim itemiz As Dictionary
    lngStatus = CommRead(intPortID, strData, 14400)

Set rs = db.OpenRecordset("tblEfdReceiptsPOS")
    If lngStatus > 0 Then
    Set Jsons = JsonConverter.ParseJson(strData)
    Z = 2
    ElseIf lngStatus < 0 Then
    Beep
    MsgBox "Please note that there is no data to read", vbOKOnly, "The Comm Port has no data"
        ' Handle error.
        On Error Resume Next
    End If
        ' Process data.
    For Each itemiz In Jsons
            With rs
            .AddNew
            rs![TPIN] = item("TPIN")
            rs![TaxpayerName] = itemiz("TaxpayerName")
            rs![Address] = itemiz("Address")
            rs![ESDTime] = itemiz("ESDTime")
            rs![TerminalID] = itemiz("TerminalID")
            rs![InvoiceCode] = itemiz("InvoiceCode")
            rs![InvoiceNumber] = itemiz("InvoiceCode")
            rs![FiscalCode] = itemiz("FiscalCode")
            rs![TalkTime] = itemiz("TalkTime")
            rs![Operator] = itemiz("Operator")
            rs![Taxlabel] = itemiz("TaxItems")("TaxLabel")
            rs![CategoryName] = itemiz("TaxItems")("CategoryName")
            rs![Rate] = itemiz("TaxItems")("Rate")
            rs![TaxAmount] = item("TaxItems")("TaxAmount")
            rs![VerificationUrl] = itemiz("TaxItems")("VerificationUrl")
            rs![INVID] = Me.ItemSoldID
            rs.Update
         End With
         Z = Z + 1
    Next
      
      rs.Close
      Set rs = Nothing
      Set db = Nothing
      Set Jsons = Nothing

Open in new window

Comment
Watch Question
Test your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Distinguished Expert 2020
Commented:
This problem has been solved!
Unlock 2 Answers and 34 Comments.
See Answers
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant

An Experts Exchange subscription includes unlimited access to online courses.

Get Started
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE