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 Solution19 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

Open in new window

ASKER CERTIFIED SOLUTION
ste5an
Senior Developer

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Log in to continue reading
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform for $9.99/mo
View membership options
Unlock 1 Answer and 11 Comments.
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
See how we're fighting big data
The Value of Experts Exchange in My Daily IT Life

Experts Exchange (EE) has become my company's go-to resource to get answers. I've used EE to make decisions, solve problems and even save customers. OutagesIO has been a challenging project and... Keep reading >>

Mike

Owner of Outages.IO
Phoenix, Arizona, United States
Member Since 2016
Join a full scale community that combines the best parts of other tools into one platform.
Unlock 1 Answer and 11 Comments.
View membership options
“All of life is about relationships, and EE has made a virtual community a real community. It lifts everyone's boat.”
William Peck

Member since 2004