Thanks a lot Hypatia
In the while I found also this method (with MailSlot) as follows
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function CreateMailslotNoSecurity Lib "kernel32" Alias "CreateMailslotA" (ByVal lpName As String, ByVal nMaxMessageSize As Long, ByVal lReadTimeout As Long, ByVal Zero As Long) As Long
Declare Function GetMailslotInfo Lib "kernel32" (ByVal hMailslot As Long, lpMaxMessageSize As Long, lpNextSize As Long, lpMessageCount As Long, lpReadTimeout As Long) As Long
Declare Function SetMailslotInfo Lib "kernel32" (ByVal hMailslot As Long, ByVal lReadTimeout As Long) As Long
Declare Function ReadFileSimple Lib "kernel32" Alias "ReadFile" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal Zero As Long) As Long
Declare Function WriteFileSimple Lib "kernel32" Alias "WriteFile" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal Zero As Long) As Long
Declare Function CreateFileNoSecurity Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal Zero As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, _
ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, _
lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes _
As Long, ByVal hTemplateFile As Long) As Long
Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function CreateMailslot Lib "kernel32" Alias "CreateMailslotA" _
(ByVal lpName As String, ByVal nMaxMessageSize As Long, _
ByVal lReadTimeout As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Const OPEN_EXISTING = 3
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const GENERIC_EXECUTE = &H20000000
Public Const GENERIC_ALL = &H10000000
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const MAILSLOT_WAIT_FOREVER = -1
Global mshandle As Long
Global Const mailslotname = "\\.\mailslot\messngr"
Global Const BufferSize = 255
Sub Main()
OpenMailSlot
ReadMailSlot
CloseMailSlot
End
End Sub
Sub OpenMailSlot()
Dim sec As SECURITY_ATTRIBUTES
With sec
.bInheritHandle = False
.lpSecurityDescriptor = 0
.nLength = Len(sec)
End With
mshandle = CreateMailslot(mailslotname, 0, 0, sec)
If mshandle = INVALID_HANDLE_VALUE Then
MsgBox "Error: cannot open mailslot.", vbCritical
End
End If
End Sub
Sub CloseMailSlot()
Dim rc As Long
rc = CloseHandle(mshandle)
End Sub
Sub ReadMailSlot()
Dim rc As Long
Dim msgtxt As String
Dim bytesread As Long
Dim msgno As Long
Dim frmtxt As String, totxt As String, msg As String, m As Integer, n As Integer
msgtxt = String(BufferSize, 0)
Do While True
rc = GetMailslotInfo(mshandle, 0, BufferSize, msgno, 0)
Do While msgno > 0
rc = ReadFileSimple(mshandle, msgtxt, Len(msgtxt) + 1, bytesread, 0)
m = 1
n = InStr(m, msgtxt, Chr(0))
If n > 0 Then
frmtxt = Mid(msgtxt, m, n - 1)
m = n + 1
End If
n = InStr(m, msgtxt, Chr(0))
If n > 0 Then
totxt = Mid(msgtxt, m, n - m)
m = n + 1
End If
n = InStr(m, msgtxt, Chr(0))
If n > 0 Then
msg = Mid(msgtxt, m, n - m)
End If
MsgBox "From: " & frmtxt & Chr(13) & Chr(10) & _
"To: " & totxt & Chr(13) & Chr(10) & _
"--------------" & Chr(13) & Chr(10) & _
msg, vbInformation + vbSystemModal
rc = GetMailslotInfo(mshandle, 0, BufferSize, msgno, 0)
Loop
Sleep 1000
DoEvents
Sleep 1000
DoEvents
Sleep 1000
DoEvents
Sleep 1000
DoEvents
Sleep 1000
DoEvents
Loop
End Sub
