Option Explicit
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
Public Type NetMessageData
sServerName As String
sSendTo As String
sSendFrom As String
sMessage As String
End Type
Private Declare Function NetMessageBufferSend Lib "netapi32" (ByVal servername As String, ByVal msgname As String, ByVal fromname As String, ByVal msgbuf As String, ByRef msgbuflen As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const ERROR_BAD_NETPATH As Long = 53
Private Const ERROR_INVALID_PARAMETER As Long = 87
Private Const ERROR_NOT_SUPPORTED As Long = 50
Private Const ERROR_INVALID_NAME As Long = 123
Private Const NERR_BASE As Long = 2100
Private Const NERR_Success As Long = 0
Private Const NERR_NetworkError As Long = (NERR_BASE + 36)
Private Const NERR_NameNotFound As Long = (NERR_BASE + 173)
Private Const NERR_UseNotFound As Long = (NERR_BASE + 150)
Private Const VER_PLATFORM_WIN32s As Long = 0
Private Const VER_PLATFORM_WIN32_WINDOWS As Long = 1
Private Const VER_PLATFORM_WIN32_NT As Long = 2
Public Function IsWinNT() As Boolean
Dim os As OSVERSIONINFO
os.dwOSVersionInfoSize = Len(os)
If GetVersionEx(os) = 1 Then
IsWinNT = (os.dwPlatformId = VER_PLATFORM_WIN32_NT)
End If
End Function
Public Function NetSendMessage(p_MsgData As NetMessageData) As String
Dim lngRet As Long
'make sure the user is on NT
If IsWinNT() Then
If p_MsgData.sSendTo = "" Then
NetSendMessage = GetNetSendMessageStatus(ERROR_INVALID_PARAMETER)
Exit Function
Else
'if there is a message
If Len(p_MsgData.sMessage) Then
'convert the strings to unicode
p_MsgData.sSendTo = StrConv(p_MsgData.sSendTo, vbUnicode)
p_MsgData.sMessage = StrConv(p_MsgData.sMessage, vbUnicode)
If Len(p_MsgData.sServerName) > 0 Then
p_MsgData.sServerName = StrConv(p_MsgData.sServerName, vbUnicode)
Else: p_MsgData.sServerName = vbNullString
End If
If Len(p_MsgData.sSendFrom) > 0 Then
p_MsgData.sSendFrom = StrConv(p_MsgData.sSendFrom, vbUnicode)
Else: p_MsgData.sSendFrom = vbNullString
End If
'change the cursor and show. Control won't return
'until the call has completed.
Screen.MousePointer = vbHourglass
lngRet = NetMessageBufferSend(p_MsgData.sServerName, p_MsgData.sSendTo, p_MsgData.sSendFrom, p_MsgData.sMessage, ByVal Len(p_MsgData.sMessage))
Screen.MousePointer = vbNormal
NetSendMessage = GetNetSendMessageStatus(lngRet)
End If
End If
End If
End Function
Private Function GetNetSendMessageStatus(p_lngError As Long) As String
Dim strMsg As String
Select Case p_lngError
Case NERR_Success: strMsg = "The message was successfully sent."
Case NERR_NameNotFound: strMsg = "Send To: user or workstation was not found."
Case NERR_NetworkError: strMsg = "A general network error occurred."
Case NERR_UseNotFound: strMsg = "The network connection could not be found."
Case ERROR_ACCESS_DENIED: strMsg = "Access to the computer denied."
Case ERROR_BAD_NETPATH: strMsg = "Sent From: server name was not found."
Case ERROR_INVALID_PARAMETER: strMsg = "Invalid parameter(s) have been specified."
Case ERROR_NOT_SUPPORTED: strMsg = "Network request not supported."
Case ERROR_INVALID_NAME: strMsg = "Illegal character or malformed name."
Case Else: strMsg = "Unknown error executing command."
End Select
GetNetSendMessageStatus = strMsg
End Function