You can use this API code
Code:Option Explicit 'Copies a block of memory from one location to another Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long) 'Allocates the specified number of bytes from the heap Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long 'Frees the specified global memory object and invalidates its handle Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long 'Sends a remote pop-up message to a user on a Windows network Private Declare Function NetMessageBufferSend Lib "NetAPI32" (ByVal ServerName As String, ByVal MsgName As Long, ByVal FromName As String, ByVal buf As Long, ByVal BufLen As Long) As Long 'Constants required by DLL function calls Private Const GMEM_ZEROINIT = &H40 Public Function NetSendMessage(ByVal StrName As String, ByVal StrMessage As String) As String 'This function sends a pop-up message to a user or computer on the network 'Return value is True if successful, False if unsuccessful On Error GoTo ErrorHandler Dim lngpMessage As Long 'Pointer to string buffer Dim lngStringSize As Long 'Length of string buffer Dim lngResult As Long 'Result of the function call 'Make sure no empty arguments were passed If Len(StrName) = 0 Then Err.Raise vbObjectError + 1000, "CNetAPI::NetSendMessage()", "You must provide a recipient name for the message." If Len(StrMessage) = 0 Then Err.Raise vbObjectError + 1001, "CNetAPI::NetSendMessage()", "Can't send an empty message." 'Voodoo for passing a pointer to a string buffer lngStringSize = Len(StrMessage) + 1 'NULL terminated string lngpMessage = GlobalAlloc(GMEM_ZEROINIT, lngStringSize) CopyMemory ByVal lngpMessage, ByVal StrMessage, lngStringSize 'Call the NetMessageBufferSend API, and return the result code back to the caller lngResult = NetMessageBufferSend(vbNullString, StrPtr(StrName), vbNullString, StrPtr(StrMessage), lngStringSize * 2) 'Release allocated resources GlobalFree lngpMessage 'Raise an error if the call to NetMessageBufferSend was unsuccessful If lngResult <> 0 Then Err.Raise vbObjectError + lngResult, "CmNetAPI::NetSendMessage()" End If 'Return the result to the caller and exit the function NetSendMessage = "" Exit Function ErrorHandler: Select Case Err.Number Case vbObjectError + 2273 Err.Description = "Either the recipient's name could not be found on the network, or the destination computer was too busy" End Select NetSendMessage = Err.Number & " (" & Err.Source & ") - " & Err.Description End Function




Reply With Quote