Private Sub Command1_Click()
 If Send(Recipient:="Rechnername", _
   Sender:="Cheffe", _
   Message:="Schluss mit Arbeit: Umtrunk " & _
   "mit Grillgut im Dachgarten!") Then
   MsgBox "Die frohe Botschaft wurde verbreitet!"
 Else
   MsgBox "Doch lieber nochmal anrufen..."
 End If
End Sub

Option Explicit
' ------------------------------------------------------
' - Nachrichten im NT-Netzwerk verschicken -
' ------------------------------------------------------
' - Beispiel zum Aufruf der API-Funktion NetMessage-   -
' - BufferSend unter Windows NT/2000/XP/Server 2003.   -
' ------------------------------------------------------
' Fehlerkonstante für NetMessageBufferSend:
Private Const NERR_SUCCESS   As Long = 0&
Private Const ERROR_ACCESS_DENIED  As Long = 5&
Private Const ERROR_NOT_SUPPORTED  As Long = 50&
Private Const ERROR_INVALID_PARAMETER As Long = 87&
Private Const NERR_BASE   As Long = 2100&
Private Const NERR_NETWORKERROR As Long = (NERR_BASE + 36&)
Private Const NERR_NAMENOTFOUND As Long = (NERR_BASE + 173&)
' Ermittlung des Betriebssystems (hier: Prüfung auf NT)
Private Const VER_PLATFORM_WIN32_NT As Long = 2&
Private Type OSVERSIONINFO
  OSVSize As Long
  dwVerMajor As Long
  dwVerMinor As Long
  dwBuildNumber As Long
  PlatformID As Long
  szCSDVersion  As String * 128
End Type
Private Declare Function GetVersionEx _
  Lib "kernel32" Alias "GetVersionExA" ( _
  ByRef VersionInformation As OSVERSIONINFO _
  ) As Long
' NET SEND-Funktionalität per NetMessageBufferSend
Private Declare Function NetMessageBufferSend _
  Lib "netapi32" ( _
  ByVal Servername As String, _
  ByVal msgname As String, _
  ByVal fromname As String, _
  ByVal buf As String, _
  ByVal buflen As Long _
  ) As Long
 
Public Function Send(Optional ByVal Recipient As String, _
   Optional ByVal Message As String, _
   Optional ByVal Sender As String, _
   Optional ByVal Servername As String) _
   As Boolean
  ' Prfe, ob ein NT-Betriebssystem vorliegt:
  If Not IsWinNT Then ' Funktion nicht ausführbar
 MsgBox "Die Send-Funktion kann nur auf Rechnern mit einem " & _
  "Betriebssystem der Windows NT-Familie verwendet " & _
  "werden.", _
  vbCritical, "Send-Funktion"
 Exit Function
  End If
  ' Wurde ein Servername übergeben, muss die
  ' UNC-Konvention eingehalten werden: <A href="file://SERVERNAME/">\\SERVERNAME</A>
  If Len(Servername) > 0 Then
 If Left$(Servername, 1) <> "\" Then
   Servername = "\" & Servername
 End If
 If Left$(Servername, 2) <> "\\" Then
   Servername = "\" & Servername
 End If
  End If
  ' Umwandeln der Angaben in Unicode-Strings:
  If Len(Recipient) > 0 Then
 Recipient = StrConv(Recipient, vbUnicode)
  Else
 Recipient = vbNullString
  End If
  If Len(Message) > 0 Then
 Message = StrConv(Message, vbUnicode)
  Else
 Message = vbNullString
  End If
  If Len(Sender) > 0 Then
 Sender = StrConv(Sender, vbUnicode)
  Else
 Sender = vbNullString
  End If
  If Len(Servername) > 0 Then
 Servername = StrConv(Servername, vbUnicode)
  Else
 Servername = vbNullString
  End If
  ' Gibt NetMessageBufferSend 0 zurück, war der Aufruf
  ' erfolgreich.
  Select Case NetMessageBufferSend(Servername, Recipient, _
  Sender, Message, _
  Len(Message))
 Case 0  ' Der Aufruf war erfolgreich
   Send = True
 ' Alle anderen Rückgaben signalisieren Fehler:
 Case ERROR_ACCESS_DENIED
   MsgBox "Zugriff verweigert.", _
 vbCritical, "Send-Funktion"
 Case ERROR_INVALID_PARAMETER
   MsgBox "Ein übergebener Parameter ist ungültig.", _
 vbCritical, "Send-Funktion"
 Case ERROR_NOT_SUPPORTED
   MsgBox "Netzwerkanfrage wird nicht unterstützt.", _
 vbCritical, "Send-Funktion"
 Case NERR_NAMENOTFOUND
   MsgBox "Benutzername wurde nicht gefunden.", _
 vbCritical, "Send-Funktion"
 Case NERR_NETWORKERROR
   MsgBox "Allgemeiner Netzwerkfehler.", _
 vbCritical, "Send-Funktion"
 Case Else
   MsgBox "Unbekannter Fehler.", _
 vbCritical, "Send-Funktion"
  End Select
End Function
 
Private Function IsWinNT() As Boolean
' Gibt zurück, ob es sich um ein Betriebssystem der
' Windows NT-Familie handelt (Windows NT, Windows 2000,
' Windows XP, Windows Server 2003) oder nicht.
Dim OSV As OSVERSIONINFO
  OSV.OSVSize = Len(OSV)
  If GetVersionEx(OSV) <> 0 Then
 IsWinNT = (OSV.PlatformID = VER_PLATFORM_WIN32_NT)
  End If
End Function
' -------------------------------------------