Option Explicit
Private Declare Function NetMessageBufferSend Lib "netapi32.dll" ( _
ByVal servername As Long, _
ByVal msgname As Long, _
ByVal fromname As Long, _
ByVal buf As Long, _
ByVal buflen As Long _
) As Long
Sub Test()
Dim l_strPC As String
Dim l_strMsg As String
Dim i As Integer
Dim l_lngRet As Long
'引数を作成
l_strPC = Environ("COMPUTERNAME")
For i = Asc("A") To Asc("Z")
l_strMsg = l_strMsg & Chr(i) & vbCrLf
Next i
'API形式で実行
l_lngRet = API形式(l_strPC, l_strMsg)
If (l_lngRet = 0) Then
Debug.Print Now & vbTab & "成功"
Else
Debug.Print Now & vbTab & "失敗"
End If
'SHELLで実行
l_lngRet = Shell形式(l_strPC, l_strMsg)
If (l_lngRet = 0) Then
Debug.Print Now & vbTab & "成功"
Else
Debug.Print Now & vbTab & "失敗"
End If
End Sub
Private Function API形式( _
ByVal p_strSendPC As String, _
ByVal p_strMsg As String _
) As Long
Dim l_lngRet As Long
Dim l_bytSendPC() As Byte
Dim l_bytMsg() As Byte
p_strMsg = "API形式" & vbCrLf & vbCrLf & p_strMsg
l_bytSendPC = p_strSendPC & vbNullChar
l_bytMsg = p_strMsg & vbNullChar
l_lngRet = NetMessageBufferSend( _
0, _
VarPtr(l_bytSendPC(0)), _
0, _
VarPtr(l_bytMsg(0)), _
LenB(p_strMsg) _
)
API形式 = l_lngRet
End Function
Private Function Shell形式( _
ByVal p_strSendPC, _
ByVal p_strMsg As String _
) As Long
Dim l_lngRet As Long
Dim l_objSehll As Object
Dim l_strCmd As String
p_strMsg = "SHELL形式" & vbCrLf & vbCrLf & p_strMsg
l_strCmd = "net send " & p_strSendPC & " """ & p_strMsg & """"
Set l_objSehll = CreateObject("WScript.Shell")
l_lngRet = l_objSehll.Run( _
l_strCmd, _
VbAppWinStyle.vbHide, _
True _
)
Shell形式 = l_lngRet
End Function
お礼
わかりやすい返答を ありがとうございました！ とても参考になりました。