troubleshooting Question

Modification of Write / Read function for a serial port in Ms Access

Avatar of Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.ScFlag for Zambia asked on
Microsoft Access
11 Comments1 Solution18 ViewsLast Modified:
Currently we have an excellent serial port system loved by many , but it has one issue , it does not allow multiple users to share the gadget. Now I'm thinking of modifying the send & write functions below to use the IP address instead of COM port , example IP = "192.168.8.103" and be declared as below, this means I will not need the open/close function since the IP address is embedded with gadget and is always automatically available and I'm to see the gadget anywhere in all remote places.

The problem here is how bring in and send  data to : 192.168.8.103

Dim intport as string
intport = "192.168.8.103"

Any idea here.

Full functions below

Private Sub CmdCread_Click()
On Error GoTo Err_Handler
Dim intPortID As integer ' Replacing with IP address of the gadget Ex. 1, 2, 3, 4 for COM1 - COM4
Dim lngStatus As Long
Dim strError  As String
Dim db As DAO.Database
Dim Rs As DAO.Recordset
Dim json As Object
Dim strData   As String
Dim Details As Variant
Dim n As Integer
Dim Z As Long
Dim strFindata As String
Dim strDataAudit As String
intPortID = COM4
If lngStatus <> 0 Then
' Initialize Communications
lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), "baud=115200 parity=N data=8 stop=1")
ElseIf lngStatus = 0 Then
End If
' Read maximum of 14400 bytes from serial port.
lngStatus = CommRead(intPortID, strData, 14400)


strFindata = Mid(strData, 8)
strDataAudit = Chr(91) & (Left(strFindata, Len(strFindata) - 6278)) & Chr(34) & "}" & Chr(93)
If lngStatus > 0 Then


    ElseIf lngStatus < 0 Then
    
  ' Handle error.
     lngStatus = CommGetError(strError)
        MsgBox "COM Error: " & strError
    End If
  'Processing data from the string above
    Set db = CurrentDb
Set Rs = db.OpenRecordset("tblEfdReceipts", dbOpenDynaset, dbSeeChanges)
    Set json = JsonConverter.ParseJson(strDataAudit)
     
    'Process data.
    Z = 1
    For Each Details In json
        Rs.AddNew
        Rs![ESDTime] = CDate(Format$(Details("ESDTime"), "00/00/00 00:00:00"))
        Rs![TerminalID] = Details("TerminalID")
        Rs![InvoiceCode] = Details("InvoiceCode")
        Rs![InvoiceNumber] = Details("InvoiceNumber")
        Rs![FiscalCode] = Details("FiscalCode")
        Rs![INVID] = Me.txtEsDFinInvoice
        Rs.Update
        Z = 1 + 1
    Next
   
    Rs.Close
    Set Rs = Nothing
    Set db = Nothing
    Set json = Nothing
    Set Details = Nothing


Call CommFlush(intPortID)
Exit Sub
' Reset modem control lines.
lngStatus = CommSetLine(intPortID, LINE_RTS, False)
lngStatus = CommSetLine(intPortID, LINE_DTR, False)
Exit_CmdCread_Click:
Exit Sub
Err_Handler:
MsgBox "strData:" & vbCrLf & ShowHex(strData)
Resume Exit_CmdCread_Click
End Sub






Private Sub CmdCwrite_Click()
On Error GoTo Err_Handler
Dim Cancel As Integer
If IsNull(Me.txtEsDFinInvoice) Then
Beep
MsgBox "Please select the invoice to sign on", vbOKOnly, "Data is required here"
Cancel = True
Exit Sub
End If
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
    Dim transaction As Dictionary
    Dim transactions As Collection
    Dim item As Dictionary
    Dim items As Collection
    Dim Tax As Collection
    Dim i As Long
    Dim j As Long
    Dim t As Long
    Dim itemCount As Long
    Dim taxCount As Long
    Dim strTaxes As Boolean
    Dim invoiceCount As Long
    Dim json As Object
    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 Details As Variant
    Dim n As Integer
    Dim s As String
    Dim Z As Long
    Set root = New Dictionary
    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 "PosSoftVersion", "2.0.0.1"
        transaction.Add "PosModel", "Cap-2017"
        transaction.Add "PosSerialNumber", DLookup("PosSerialNumber", "tblEFDs", "ID = 1")
        transaction.Add "IssueTime", DateAdd("n", 130, Now())
        transaction.Add "TransactionType", DLookup("ReceiptType", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        transaction.Add "PaymentMode", DLookup("Cashremit", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        transaction.Add "SaleType", DLookup("RevenueType", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        transaction.Add "LocalPurchaseOrder", DLookup("LocalPurchaseOrder", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        transaction.Add "Cashier", DLookup("Cashier", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        transaction.Add "BuyerTPIN", DLookup("BuyerTPIN", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        transaction.Add "BuyerName", DLookup("BuyerName", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        transaction.Add "BuyerTaxAccountName", DLookup("BuyerTaxAccountName", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        transaction.Add "BuyerAddress", DLookup("BuyerAddress", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        transaction.Add "BuyerTel", DLookup("BuyerTel", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        transaction.Add "OriginalInvoiceCode", DLookup("OrignalInvoiceCode", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        transaction.Add "OriginalInvoiceNumber", DLookup("OrignalInvoiceNumber", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        transaction.Add "Memo", DLookup("TheNotes", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        transaction.Add "Currency-Type", DLookup("MoneyType", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        transaction.Add "Conversion-Rate", DLookup("FCrate", "tblCustomerInvoice", "[InvoiceID]= " & Me.CboEsdInvoices)
        '--- loop over all the items
        itemCount = Me.txtinternalaudit
        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.CboEsdInvoices & " AND ItemesID =" & CStr(i))
            item.Add "BarCode", DLookup("BarCode", "QryJson", "InvoiceID =" & Me.CboEsdInvoices & " AND ItemesID =" & CStr(i))
            item.Add "Quantity", DLookup("Quantity", "QryJson", "InvoiceID =" & Me.CboEsdInvoices & " AND ItemesID =" & CStr(i))
            item.Add "UnitPrice", DLookup("UnitPrice", "QryJson", "InvoiceID =" & Me.CboEsdInvoices & " AND ItemesID =" & CStr(i))
            item.Add "Discount", 0
            '--- loop over all the taxes
            taxCount = 1
            Set Tax = New Collection
             strTaxes = DLookup("CGControl", "QryJson", "InvoiceID =" & Me.CboEsdInvoices & " AND ItemesID =" & CStr(i))
            '--- loop over all the invoices
            invoiceCount = 1
            For j = 1 To invoiceCount
                For t = 1 To taxCount
            Next t
            item.Add "TaxLabels", Tax
            
            Tax.Add DLookup("TaxClassA", "QryJson", "InvoiceID =" & Me.CboEsdInvoices & " AND ItemesID =" & CStr(i))
               If Len(Trim(Nz(DLookup("TourismClass", "QryJson", "InvoiceID =" & Me.CboEsdInvoices & " AND ItemesID =" & CStr(i)), ""))) > 0 Then
               Tax.Add Nz(DLookup("TourismClass", "QryJson", "InvoiceID =" & Me.CboEsdInvoices & " AND ItemesID =" & CStr(i)), "")
               End If
            If Len(Trim(Nz(DLookup("InsuranceClass", "QryJson", "InvoiceID =" & Me.CboEsdInvoices & " AND ItemesID =" & CStr(i)), ""))) > 0 Then
               Tax.Add Nz(DLookup("InsuranceClass", "QryJson", "InvoiceID =" & Me.CboEsdInvoices & " AND ItemesID =" & CStr(i)), "")
               End If
            item.Add "TotalAmount", DLookup("TotalAmount", "QryJson", "InvoiceID =" & Me.CboEsdInvoices & " AND ItemesID =" & CStr(i))
            item.Add "IsTaxInclusive", strTaxes
            item.Add "RRP", DLookup("RRP", "QryJson", "InvoiceID =" & Me.CboEsdInvoices & " AND ItemesID =" & CStr(i))
                
            Next j
            
            items.Add item
        Next i
        transaction.Add "Items", items
        
        Rs.MoveNext
    Loop
    
    root.Add "", transaction
    On Error Resume Next
    intPortID = COM4
    Call CommFlush(intPortID)
    If lngStatus <> 0 Then
Application.Quit
ElseIf lngStatus = 0 Then
End If
    ' Write data to serial port.
    ' Build data packet to transmit (passing command code, and data to package)
    strData = BuildData(JsonConverter.ConvertToJson(transaction, Whitespace:=3))
  
                 
    ' Send the data packet and check for error
    lngStatus = CommWrite(intPortID, strData)
    If lngStatus <> Len(strData) Then
Beep
MsgBox "There is no data to write", vbOKOnly, "Data is required here"
    Application.Quit
    
        ' Handle error.
    lngStatus = CommGetError(strError)
        MsgBox "COM Error: " & strError
    End If


Rs.Close
    Set Rs = Nothing
    Set db = Nothing
    Set json = Nothing
    Set transaction = Nothing
    Set transactions = Nothing
    Set item = Nothing
    Set items = Nothing
    Set Tax = Nothing
    Set fld = Nothing
    Set root = Nothing
    Set qdf = Nothing
    Set prm = Nothing
    Set Details = Nothing


Exit Sub
Exit_CmdCwrite_Click:
Exit Sub
Err_Handler:
MsgBox Err.Number & Err.Description, vbExclamation, "Error"
Resume Exit_CmdCwrite_Click
End Sub
Join the community to see this answer!
Join our exclusive community to see this answer & millions of others.
Unlock 1 Answer and 11 Comments.
Join the Community
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 11 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros