Failed connection VBA/RS 232

Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc used Ask the Experts™
on
Dear all;
I need your help to spot why the code below failed to run or connect to RS 232/VBA Ms Access. First and foremost, below is the specification of the machine provided by the Taxman:
1.      Configuration for the serial port is as follows:
 "baud=115200
parity=N
data=8
stop=1"
there is no restriction on the write/read data rate
2.      we leave the port open 24 hours service. We suggest you use this approach. Leave the port open.
3.      Every information returned by the ESD during invoice signing request should be printed on the invoice.
 
End of instruction guide by the Taxman

The assembled code below is in 4 stages, I will explain all the stages in details below:

(1)      
CommOpen(intPortID

Open in new window

:
This is the first stage of interaction with the machine, the code here is used to open the gadget or initialise if like it that way. I have no problem with this.

(2)      
CommWrite(intPortID, strData)

Open in new window

:
The second stage is to now write the data into the port. What I have done here is to put the converted Json data into a string first as follows:
           
 strData = JsonConverter.ConvertToJson(transaction, Whitespace:=3)

Open in new window

Then assign that Json data into string as below:
lngStatus = CommWrite(intPortID, strData)

Open in new window


(3)      Finally, I have now put an error handling code see below

END OF SENDING DATA WITH JSON FORMAT

Full code below:
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
    ' 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
Call CmdReadWrite_Click
Exit_CmdConertJson_Click:
Exit Sub
Err_Handler:
Resume Exit_CmdConertJson_Click
End Sub

Open in new window


Reading Data Code

This where I have BIG problems, see issues below:
(1)      I’m required to leave the code open without limitation:

lngStatus = CommRead(intPortID, strData, 14400)

The above limitation is not required (14400) it must be open, but if do not put something it always gives an error request for a missing parameter.
(2)      I’m not very sure whether the code below functions properly, someone helped me here sometime back, but I cannot remember what was discussed about it I have a lot of ?????????? here:
                 
ReadDataFromSerialDevice (DataRead, 4)

Open in new window

(3)      I want to now store the received data from the gadget into table called ("tblEfdReceipts"), but here, that is where another challenge is Im completely lost here, I have put a code below just on try and error basis, can someone help me here????????????
           
StoreData DataObject

Open in new window

(4)      Because the received data need to be attached with the sent invoice details and signed by the Taxman server, I have now attempted to attach the actual invoice, see below:

 rs![INVID] = Me.InvoiceID

Open in new window


Summary

The data cannot be sent and signed up from the Taxman server as long the above issues mentioned above cannot be resolved. I feel the major problem is on the receiving side and the parameter limitation. Kindly see how you can help on this.
The worst case scenario is that now we have to wait for another 90 days to have this software retested due to a huge number of people lining up for the same certification with taxman.

Full code for receiving

Private Sub CmdReadWrite_Click()
Dim DataRead As String
  Dim DataObject As Object

  If ReadDataFromSerialDevice (DataRead, 4) Then
    ' Call to your JSON library to parse it.
    Set DataObject = ParseJson(DataRead)
    StoreData DataObject
    MsgBox "Data have written in the contact table", vbExclamation, "Please proceed"
    Set DataObject = Nothing
  End If

End Sub

Open in new window

Private Function ReadDataFromSerialDevice (ByRef ADataRead As String, APortID As Long) As Boolean

  Dim lngStatus As Long
  Dim strData As String
  Dim intPortID As Integer

  ReadDataFromSerialDevice = False
   lngStatus = CommRead(intPortID, strData, 14400)
    If lngStatus > 0 Then
    ADataRead = strData
    ReadDataFromSerialDevice = True
  End If

  lngStatus = CommSetLine(intPortID, LINE_RTS, False)
  lngStatus = CommSetLine(intPortID, LINE_DTR, False)
  ' Close communications.
    Call CommClose(intPortID)
End Function

Open in new window

Private Sub StoreData(ADataObject As Object)

  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim item As Object

  Set db = CurrentDb
  Set rs = db.OpenRecordset("tblEfdReceipts")
  For Each item In ADataObject
    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

End Sub

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
ste5anSenior Developer

Commented:
What kind of device is this? How is the general processing defined by the manufacturer? Is it a poll or push communication? Are there mandatory requirements, like reaction times?

(1)      I’m required to leave the code open without limitation:
If this is true, then you cannot do in Access. Then you need a Windows Service which does the serial communication. Cause the event processing model of Access cannot be used in some scenarios to query data from a serial port "without limitations".
It appears to be a pull communication type,

I have also tried to change the following :

intPortID

Open in new window

 to be more specific by assigning the actual port number (
intPortID  = 2

Open in new window

)

And change this on receipt part from
StoreData DataObject

Open in new window

to
StoreData (DataObject)

Open in new window


Now I'm getting an error below:


Customers-maintenance.png
ste5anSenior Developer

Commented:
The problem is: Your code is unstructured as you've just thrown pieces together.

You call cmdReadWrite, which calls ReadDataFromSerialDevice, which imho tries to open the port. This must fail, cause the port is still open.

To get this clean, start over by describing the overall process.
Create a Nassi-Shneiderman diagram showing the overall communication with the device.
Then create detailed ones for sending and receiving data. Here also look at the device specifications. Cause you're using RTS and DTR line signaling, but you wrote that this is not part of the device specification. Why do use this signaling?

Now think about how you like to handle the serial port. Keep in mind, it's a singular resource. I would consider using a (hidden) form to encapsulate all functionality. Cause then you can make it visible for debugging.
Although I do not have a machine to test this right now, I think the error sending is coming from  here:

(1) Not assigning the com port with a value before attempting to open it:

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
    ' Initialize Communications
    lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), _
        "baud=115200 parity=N data=8 stop=1")

Open in new window


The Correct way is as follow:

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  '( Example the port to used ,whether USB or RS 232 )
    ' Initialize Communications
    lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), _
        "baud=115200 parity=N data=8 stop=1")

Open in new window



I think for sending purpose it should work.

Now receiving that where I strongly DOUBT THIS :

StoreData DataObject

Open in new window


I think the correct method is as follows:

StoreData (DataObject)

Open in new window

ste5anSenior Developer

Commented:
Well, exactly as I said, your code is unstructured as you've just thrown pieces together. You should do yourself a favor and use a more structured approach. Especially as you're code needs to get certified.

StoreData DataObject vs. StoreData (DataObject) only matters when your DataObject is a COM+ object. In this case, the parentheses enforce an kind of unmarshalling as far as I can remember. For plain VBA, this makes no difference.

(1) Not assigning the com port with a value before attempting to open it:
You assigned a port number, namely the default integer of value 0, which is a valid com port number in some installations. So I thought this was intentional.
Again, use a more structured approach. Define and store the configuration. Load it. Display it in the case of an error...

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial