We help IT Professionals succeed at work.

VBA for Sending & Receiving data from RS 232 ( Auditing required)

Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc used Ask the Experts™
on
I have restructured my VBA for sending & receiving data from & to RS 232 comm port , kindly advise where you still see some errors , the below code will under go certification next month , January 2020 with the Taxman , that is the reason why I need to get it right. I know we have many experts  here to assist on this.

Your assistance will be highly appreciated as usual.

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 this where the data is supposed to be read and written the Ms Access table locally
' Read maximum of 64 bytes from serial port.

Dim JSONS As Object

    lngStatus = CommRead(intPortID, strData, 14400)
Set JSONS = ParseJson(strData)
Set rs = db.OpenRecordset("tblEfdReceipts")
    If lngStatus > 0 Then
    ElseIf lngStatus < 0 Then
        ' Handle error.
    End If
        ' Process data.
  Set JSONS = ParseJson(strData)
        
  For Each item In JSONS
  i = 2
  With rs
            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
    
    Next
      i = i + 1
      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

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Senior Developer
Commented:
At a first glance:

- It contains dead code.
- Inconsistent declaration naming style for names.
- Inconsistent declaration naming style for references.
- Inconsistent indentation.
- It uses Eval().
- It contains meaningless comments.
- No data validation.
- Inconsistent use of data sources (concurrency incoherence between rs and DLookup).
- It uses hard coded values, which are clearly configuration.
- it uses MsgBox internally.
- Unused variables.
- It violates the separation of concerns principle (SoC, in OOP known as single responsibility principle, SRP):
   a) Your method is overloaded.
   b) Error handling and logging is not as granular as it could and (imho) should be.

As VBA has no "inner scope", the common structure of a method is:

1. const declarations
2. error handler declaration
3. variable declaration
4. method body
5. single point of return
6. error handler

Point 3. means all variable declarations are in one place and scattered around the method. In your concrete case the Dim's at different locations also indicate SoC, thus you have stuffed to much into one single procedure.
Point 5. means a single exit in the case of no error. The error handler may have its own exit.

A method should do one thing. Thus it should be small.

The methods in your audit case must provide proper logging and error handling. This implies often to store the data which is used in a history/audit table for some time.
ste5an

Are trying to provide any solution or you have non at all.
- It contains dead code.

Which ?
ste5anSenior Developer

Commented:
Are trying to provide any solution or you have non at all.
For all points mentioned in the above post, I have already shown a possible structured approach in some of your different threads.

And for the rest, in order of the points mentioned:

- Remove dead code.
- Use a consistent naming style for declaring names.
- Use a consistent naming style for declaration references.
- Use consistent indentation.
- Don't use Eval().
- Remove meaningless comments.
- Add data validation.
- Use a single data source.
- Move hard coded values into configuration.
- Don't use MsgBox internally.
- Remove unused variables.
- Use the extract method refactoring method to move out the separate concerns into their own methods.
ste5anSenior Developer

Commented:
It contains dead code. Which ?
Line 2.

And redundant code in lines 147, 148, 166, 169.
ste5anSenior Developer

Commented:
btw, start with point 12.