VBA for Sending & Receiving data from RS 232 ( Auditing required)
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.
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
- It contains dead code.
Which ?
Which ?
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.
It contains dead code. Which ?Line 2.
And redundant code in lines 147, 148, 166, 169.
btw, start with point 12.
ASKER
Okay noted
ASKER
Are trying to provide any solution or you have non at all.