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?
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
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
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)
Last Comment
Actually its in a module and being called from an onclick event but its giving me some character see below
We're obviously missing code as I don't see any message box commands, yet you are displaying one on the form.
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
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
See also the attached manual just in case I misinterpreted
Control over LAN using Microsoft Excel.pdf
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:
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
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
See also the attached manual just in case I misinterpreted
Control over LAN using Microsoft Excel.pdf
from your codes, you're calling function: RecvAscii like this:
try debug these variables for your string manipulation.
lngStatus = RecvAscii(strData, 20480)
x = RecvAscii(strData, 60)
try debug these variables for your string manipulation.
I have removed lngStatus = RecvAscii(strData, 20480) but still its still hanging
ASKER CERTIFIED SOLUTION
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
Microsoft Access
Microsoft Access is a rapid application development (RAD) relational database tool. Access can be used for both desktop and web-based applications, and uses VBA (Visual Basic for Applications) as its coding language.
226K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts
TRUSTED BY
if it doesn't work, it probably is the function's issue within.