How to a public function from an onclick sub in Ms Access

Dear All;

I'm struggling to a call this function below to be used in an on click event in Ms Access, any idea here?

Public Function RecvAscii(dataBuf As String, ByVal maxLength As Integer) As Integer
    Dim count As Long
    Dim c As String * 12288
    Dim length As Integer
   
    dataBuf = ""
    While length < maxLength
        DoEvents
        count = recv(socketId, c, 12288, 0)
        If count < 1 Then
            RecvAscii = RECV_ERROR
            dataBuf = Chr$(0)
            Exit Function
        End If
       
        If c = Chr$(10) Then
           dataBuf = dataBuf + Chr$(0)
           RecvAscii = NO_ERROR
           Exit Function
        End If
       
        length = length + count
        dataBuf = dataBuf + c
    Wend
   
    RecvAscii = RECV_ERROR
   
End Function

Open in new window

I want to get the data from using above function so that once I get it then I have an opportunity to trim it to get only what I need because not all the data is required here:

The VBA below need to use the above function to polish up the needed data and that is where the problem is how to call that function and use its data into the cutting area

Private Sub CmdCread_Click()
Dim lngstatus As Long
Dim strData As String
Dim strFindata As String
Dim strDataAudit As String
' Read maximum bytes from TCP/IP Port.
lngstatus = RecvAscii(strData, 40000)
'After receiving all the data I want to trim so that I remain with the required data
strFindata = Mid(strData, 8)
strDataAudit = Chr(91) & (Left(strFindata, Len(strFindata) - 6278)) & Chr(34) & "}" & Chr(93)

Open in new window

Ryan Chong

have you tried put the above function into a Module?

if it doesn't work, it probably is the function's issue within.

Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc

ASKER

Actually its in a module and being called from an onclick event but its giving me some character see below

Daniel Pineault

We're obviously missing code as I don't see any message box commands, yet you are displaying one on the form.

Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc

ASKER

Here is the VBA for receiving in full

Private Sub CmdCread_Click()
On Error GoTo Err_Handler
Dim db As DAO.Database
Dim Rs As DAO.Recordset
Dim lngStatus As Long
Dim strData As String * 20480
Dim json As Object
Dim Details As Variant
Dim Z As Long
Dim strFindata As String
Dim strDataAudit As String


' Read maximum of 20480 bytes from TCP/IP Port.Please note 20480 = buffer while 20480 = Length
lngStatus = RecvAscii(strData, 20480)
strFindata = Mid(strData, 8)
strDataAudit = Chr(91) & (Left(strFindata, Len(strFindata) - 6278)) & Chr(34) & "}" & Chr(93)


'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
MsgBox "Please note that the serial port has finished processing and is now closing", vbExclamation, "Please Note That The Port Is Now Closing"
Call CloseConnection
Exit Sub
Exit_CmdCread_Click:
Exit Sub
Err_Handler:
MsgBox "strData:" & vbCrLf & ShowHex(strData)
Resume Exit_CmdCread_Click
End Sub

Open in new window

Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc

ASKER

Opening the socket and sending is very much Ok see below the data that is being sent below, I also tested the same data below with the working COM Serial Port I'm able to receive a good response.

The problem is with TCP/IP protocol, the system get chocked when receiving data , the issue could be VBA code for receiving and the BUFFER SETTING + HOW IT IS CALLED

0000 =  1A 5D 02 00 00 03 D5 7B 0D 0A 20 20 20 22 50 6F | ..]..........{....   "Po
0010 =  73 56 65 6E 64 6F 72 22 3A 20 22 4E 65 63 74 6F | sVendor": "Necto
0020 =  72 20 50 72 69 6D 65 20 41 63 63 6F 75 6E 74 69 | r Prime Accounti
0030 =  6E 67 20 53 6F 6C 75 74 69 6F 6E 73 22 2C 0D 0A | ng Solutions",....
0040 =  20 20 20 22 50 6F 73 53 6F 66 74 56 65 72 73 69 |    "PosSoftVersi
0050 =  6F 6E 22 3A 20 22 32 2E 30 2E 30 2E 31 22 2C 0D | on": "2.0.0.1",..
0060 =  0A 20 20 20 22 50 6F 73 4D 6F 64 65 6C 22 3A 20 | ..   "PosModel":
0070 =  22 43 61 70 2D 32 30 31 37 22 2C 0D 0A 20 20 20 | "Cap-2017",....  
0080 =  22 50 6F 73 53 65 72 69 61 6C 4E 75 6D 62 65 72 | "PosSerialNumber
0090 =  22 3A 20 22 31 30 30 31 30 30 30 30 31 38 32 39 | ": "100100001829
00A0 =  22 2C 0D 0A 20 20 20 22 49 73 73 75 65 54 69 6D | ",....   "IssueTim
00B0 =  65 22 3A 20 22 32 30 32 31 30 37 31 37 31 37 35 | e": "20210717175
00C0 =  36 30 31 22 2C 0D 0A 20 20 20 22 54 72 61 6E 73 | 601",....   "Trans
00D0 =  61 63 74 69 6F 6E 54 79 70 65 22 3A 20 30 2C 0D | actionType": 0,..
00E0 =  0A 20 20 20 22 50 61 79 6D 65 6E 74 4D 6F 64 65 | ..   "PaymentMode
00F0 =  22 3A 20 30 2C 0D 0A 20 20 20 22 53 61 6C 65 54 | ": 0,....   "SaleT
0100 =  79 70 65 22 3A 20 30 2C 0D 0A 20 20 20 22 4C 6F | ype": 0,....   "Lo
0110 =  63 61 6C 50 75 72 63 68 61 73 65 4F 72 64 65 72 | calPurchaseOrder
0120 =  22 3A 20 6E 75 6C 6C 2C 0D 0A 20 20 20 22 43 61 | ": null,....   "Ca
0130 =  73 68 69 65 72 22 3A 20 22 41 64 6D 69 6E 20 4D | shier": "Admin M
0140 =  61 6E 61 67 65 72 22 2C 0D 0A 20 20 20 22 42 75 | anager",....   "Bu
0150 =  79 65 72 54 50 49 4E 22 3A 20 22 31 30 32 32 35 | yerTPIN": "10225
0160 =  33 30 30 33 54 22 2C 0D 0A 20 20 20 22 42 75 79 | 3003T",....   "Buy
0170 =  65 72 4E 61 6D 65 22 3A 20 22 4E 64 6F 6C 61 20 | erName": "Ndola
0180 =  50 6C 61 6E 6E 69 6E 67 20 47 72 6F 75 70 22 2C | Planning Group",
0190 =  0D 0A 20 20 20 22 42 75 79 65 72 54 61 78 41 63 | ....   "BuyerTaxAc
01A0 =  63 6F 75 6E 74 4E 61 6D 65 22 3A 20 22 4E 64 6F | countName": "Ndo
01B0 =  6C 61 20 50 6C 61 6E 6E 69 6E 67 20 47 72 6F 75 | la Planning Grou
01C0 =  70 22 2C 0D 0A 20 20 20 22 42 75 79 65 72 41 64 | p",....   "BuyerAd
01D0 =  64 72 65 73 73 22 3A 20 22 42 6F 78 22 2C 0D 0A | dress": "Box",....
01E0 =  20 20 20 22 42 75 79 65 72 54 65 6C 22 3A 20 6E |    "BuyerTel": n
01F0 =  75 6C 6C 2C 0D 0A 20 20 20 22 4F 72 69 67 69 6E | ull,....   "Origin
0200 =  61 6C 49 6E 76 6F 69 63 65 43 6F 64 65 22 3A 20 | alInvoiceCode":
0210 =  6E 75 6C 6C 2C 0D 0A 20 20 20 22 4F 72 69 67 69 | null,....   "Origi
0220 =  6E 61 6C 49 6E 76 6F 69 63 65 4E 75 6D 62 65 72 | nalInvoiceNumber
0230 =  22 3A 20 6E 75 6C 6C 2C 0D 0A 20 20 20 22 4D 65 | ": null,....   "Me
0240 =  6D 6F 22 3A 20 6E 75 6C 6C 2C 0D 0A 20 20 20 22 | mo": null,....   "
0250 =  43 75 72 72 65 6E 63 79 2D 54 79 70 65 22 3A 20 | Currency-Type":
0260 =  22 5A 4D 57 22 2C 0D 0A 20 20 20 22 43 6F 6E 76 | "ZMW",....   "Conv
0270 =  65 72 73 69 6F 6E 2D 52 61 74 65 22 3A 20 31 2C | ersion-Rate": 1,
0280 =  0D 0A 20 20 20 22 49 74 65 6D 73 22 3A 20 5B 0D | ....   "Items": [..
0290 =  0A 20 20 20 20 20 20 7B 0D 0A 20 20 20 20 20 20 | ..      {....      
02A0 =  20 20 20 22 49 74 65 6D 49 64 22 3A 20 31 2C 0D |    "ItemId": 1,..
02B0 =  0A 20 20 20 20 20 20 20 20 20 22 44 65 73 63 72 | ..         "Descr
02C0 =  69 70 74 69 6F 6E 22 3A 20 22 46 72 75 69 74 20 | iption": "Fruit
02D0 =  4A 75 69 63 65 22 2C 0D 0A 20 20 20 20 20 20 20 | Juice",....      
02E0 =  20 20 22 42 61 72 43 6F 64 65 22 3A 20 22 32 30 |   "BarCode": "20
02F0 =  30 30 22 2C 0D 0A 20 20 20 20 20 20 20 20 20 22 | 00",....         "
0300 =  51 75 61 6E 74 69 74 79 22 3A 20 31 2C 0D 0A 20 | Quantity": 1,....
0310 =  20 20 20 20 20 20 20 20 22 55 6E 69 74 50 72 69 |         "UnitPri
0320 =  63 65 22 3A 20 38 36 2C 0D 0A 20 20 20 20 20 20 | ce": 86,....      
0330 =  20 20 20 22 44 69 73 63 6F 75 6E 74 22 3A 20 30 |    "Discount": 0
0340 =  2C 0D 0A 20 20 20 20 20 20 20 20 20 22 54 61 78 | ,....         "Tax
0350 =  4C 61 62 65 6C 73 22 3A 20 5B 0D 0A 20 20 20 20 | Labels": [....    
0360 =  20 20 20 20 20 20 20 20 22 41 22 0D 0A 20 20 20 |         "A"....  
0370 =  20 20 20 20 20 20 5D 2C 0D 0A 20 20 20 20 20 20 |       ],....      
0380 =  20 20 20 22 54 6F 74 61 6C 41 6D 6F 75 6E 74 22 |    "TotalAmount"
0390 =  3A 20 38 36 2C 0D 0A 20 20 20 20 20 20 20 20 20 | : 86,....        
03A0 =  22 49 73 54 61 78 49 6E 63 6C 75 73 69 76 65 22 | "IsTaxInclusive"
03B0 =  3A 20 74 72 75 65 2C 0D 0A 20 20 20 20 20 20 20 | : true,....      
03C0 =  20 20 22 52 52 50 22 3A 20 30 0D 0A 20 20 20 20 |   "RRP": 0....    
03D0 =  20 20 7D 0D 0A 20 20 20 5D 0D 0A 7D 4E D8 20 20 |   }....   ]....}N..  
03E0 =  20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 |                
03F0 =  20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 |                

My VBA code I'm using to receive data see below:

Open in new window

Private Sub CmdCread_Click()
On Error GoTo Err_Handler
Dim db As DAO.Database
Dim Rs As DAO.Recordset
Dim x As Long
Dim strData As String
Dim json As Object
Dim Details As Variant
Dim Z As Long
Dim strFindata As String
Dim strDataAudit As String
Call OpenSocket("192.168.1.197", 8888)
' Read maximum of 20480 bytes from TCP/IP Port.Please note 20480 = buffer while 20480 = Length
x = RecvAscii(strData, 60)


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


'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
MsgBox "Please note that the serial port has finished processing and is now closing", vbExclamation, "Please Note That The Port Is Now Closing"


Exit Sub
Exit_CmdCread_Click:
Exit Sub
Err_Handler:
MsgBox "strData:" & vbCrLf & ShowHex(strData)
Resume Exit_CmdCread_Click
End Sub

Open in new window

Below is the VBA Function I'm trying to call with the BUFFER:

Public Function RecvAscii(dataBuf As String, ByVal maxLength As Integer) As Integer
    Dim count As Long
    Dim c As String * 1
    Dim length As Integer
    
    dataBuf = ""
    While length < maxLength
        DoEvents
        count = recv(socketId, c, 1, 0)
        If count < 1 Then
            RecvAscii = RECV_ERROR
            dataBuf = Chr$(0)
            Exit Function
        End If
        
        If c = Chr$(10) Then
           dataBuf = dataBuf + Chr$(0)
           RecvAscii = NO_ERROR
           Exit Function
        End If
        
        length = length + count
        dataBuf = dataBuf + c
    Wend
    
    RecvAscii = RECV_ERROR
    
End Function

Open in new window

See also the attached manual just in case I misinterpreted

Control over LAN using Microsoft Excel.pdf

Ryan Chong

from your codes, you're calling function: RecvAscii like this:

lngStatus = RecvAscii(strData, 20480)
x = RecvAscii(strData, 60)

Open in new window

but these variables are not being used at all.

try debug these variables for your string manipulation.

Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc

ASKER

I have removed lngStatus = RecvAscii(strData, 20480) but still its still hanging

ASKER CERTIFIED SOLUTION

Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial