Sub Main()
  If App.PrevInstance Then End 'для proga1
...

    PipeHandle = CreateNamedPipe(BasePipeName + CStr(ID), _
        PIPE_ACCESS_DUPLEX Or FILE_FLAG_WRITE_THROUGH, PipeMode, _
        PIPE_UNLIMITED_INSTANCES, 1000, 1000, 20000, SA)

            ' Создаем пайп в потоке (поток не ждем, закрываем описатель, RefCount = 1)
            Call CloseHandle(CreateThread(SA, 0, AddressOf PipeThreadRoutine, 0, 0, 0))

Private Sub Form_Load()
    Dim hThreadID As Long
    CreateThread 0, 0, AddressOf AsyncThread, threadparam, 0, hThreadID
End Sub

'форма
Option Explicit

Private Sub Form_Load()
  '\\ Use (after creating the window...)
  OldWindowProc = SetWindowLong(Me.hwnd, _
   GWL_WNDPROC, AddressOf NewWindowProc)
End Sub

'модуль
Public OldWindowProc As Long

Public Const GWL_WNDPROC = (-4)

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
 (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
 ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  
Public Const MSG_CHANGENOTIFY = "MCL_PRINT_NOTIFY"

'\\ Declaration to register custom messages
Private Declare Function RegisterWindowMessage Lib "user32" Alias _
 "RegisterWindowMessageA" (ByVal lpString As String) As Long
  
Public Function NewWindowProc(ByVal hwnd As Long, _
 ByVal wMsg As Long, ByVal wParam As Long, _
 ByVal lParam As Long) As Long
     
  If wMsg = WM_MCL_CHANGENOTIFY Then
    '\\Respond to the custom message here
    Form1.Label1.Caption = Form1.Label1.Caption + 1
  Else
    '\\Pass the message to the previous
    '\\window procedure to handle it
    NewWindowProc = CallWindowProc(OldWindowProc, hwnd, _
     wMsg, wParam, lParam)
  End If
     
End Function

Public Function WM_MCL_CHANGENOTIFY() As Long
  Static Msg As Long
      
  If Msg = 0 Then
    Msg = RegisterWindowMessage(MSG_CHANGENOTIFY)
  End If
     
  WM_MCL_CHANGENOTIFY = Msg
     
End Function

'форма
Private Sub Command1_Click()
  Dim hwndTarget As Long
  
  hwndTarget = FindWindow(vbNullString, WINDOWTITLE_SERVER)
  
  If hwndTarget <> 0 Then
    Call SendMessageLong(hwndTarget, _
     WM_MCL_CHANGENOTIFY, 0, 0)
  End If
End Sub
'модуль
Option Explicit

Public Const WINDOWTITLE_SERVER = "Merrion Computing IPC - Server"
Public Const MSG_CHANGENOTIFY = "MCL_PRINT_NOTIFY"

'\\ Declarations
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" _
 (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam _
 As Long, ByVal lParam As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
 (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'\\ Declaration to register custom messages
Private Declare Function RegisterWindowMessage Lib "user32" Alias _
 "RegisterWindowMessageA" (ByVal lpString As String) As Long

Public Function WM_MCL_CHANGENOTIFY() As Long
  Static Msg As Long
      
  If Msg = 0 Then
    Msg = RegisterWindowMessage(MSG_CHANGENOTIFY)
  End If
     
  WM_MCL_CHANGENOTIFY = Msg
     
End Function