Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Net Send and VBA 3

Status
Not open for further replies.

Trudye

Programmer
Sep 4, 2001
932
US
Hi Guys, Can I use the Net Send command from VBA?

Thanx
Trudye
 
You can run a dos command using the shell, so maybe:

Shell("Net Send Trudye Hello!")
 
[vb]

Option Explicit

Const ERROR_SUCCESS = 0
Const ERROR_MORE_DATA = 234
Const SV_TYPE_SERVER = &H2
Const SIZE_SI_101 = 24

Private Type SERVER_INFO_101
dwPlatformId As Long
lpszServerName As Long
dwVersionMajor As Long
dwVersionMinor As Long
dwType As Long
lpszComment As Long
End Type

Private Declare Function NetServerEnum Lib "netapi32.dll" (ByVal servername As String, _
ByVal level As Long, buffer As Long, ByVal prefmaxlen As Long, entriesread As Long, _
totalentries As Long, ByVal servertype As Long, ByVal domain As String, resumehandle As Long) As Long

Private Declare Function NetApiBufferFree Lib "netapi32.dll" (BufPtr As Any) As Long
Private Declare Sub RtlMoveMemory Lib "KERNEL32" _
(hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function lstrcpyW Lib "KERNEL32" _
(ByVal lpszDest As String, ByVal lpszSrc As Long) As Long

Private Const NERR_Success As Long = 0&
Private Const NERR_BASE = 2100
Private Const NERR_NameNotFound = NERR_BASE + 173
Private Const NERR_NetworkError = NERR_BASE + 36
Private Const ERROR_ACCESS_DENIED = 5
Private Const ERROR_INVALID_PARAMETER = 87
Private Const ERROR_NOT_SUPPORTED = 50

Private Declare Function NetMessageBufferSend Lib "netapi32.dll" (servername As Any, _
msgname As Byte, fromname As Any, buf As Byte, ByVal buflen As Long) As Long

Private Sub cmdSend_Click()
Dim nRet As Long
Dim sTo() As Byte
Dim sMsg() As Byte

sTo = lst.List(lst.ListIndex) & Chr(0)
sMsg = txtMsg & Chr(0)
nRet = NetMessageBufferSend(ByVal 0, sTo(0), ByVal 0, sMsg(0), UBound(sMsg))
Select Case nRet
Case NERR_Success: MsgBox "Success"
Case NERR_NameNotFound: MsgBox "NameNotFound"
Case NERR_NetworkError: MsgBox "NetworkError"
Case ERROR_ACCESS_DENIED: MsgBox "ACCESS_DENIED"
Case ERROR_INVALID_PARAMETER: MsgBox "INVALID_PARAMETER"
Case ERROR_NOT_SUPPORTED: MsgBox "NOT_SUPPORTED"
Case Else: MsgBox "Unexpected error"
End Select
End Sub

Private Function PointerToString(lpszString As Long) As String
Dim lpszStr1 As String, lpszStr2 As String, nRet As Long
lpszStr1 = String(1000, "*")
nRet = lstrcpyW(lpszStr1, lpszString)
lpszStr2 = (StrConv(lpszStr1, vbFromUnicode))
PointerToString = Left(lpszStr2, InStr(lpszStr2, Chr$(0)) - 1)
End Function

Private Sub Form_Load()
Dim pszServer As String, pszDomain As String
Dim nLevel As Long, i As Long, BufPtr As Long, TempBufPtr As Long
Dim nPrefMaxLen As Long, nEntriesRead As Long, nTotalEntries As Long
Dim nServerType As Long, nResumeHandle As Long, nRet As Long
Dim ServerInfo As SERVER_INFO_101

nLevel = 101
BufPtr = 0
nPrefMaxLen = &HFFFFFFFF
nEntriesRead = 0
nTotalEntries = 0
nServerType = SV_TYPE_SERVER
nResumeHandle = 0

Do
nRet = NetServerEnum(pszServer, nLevel, BufPtr, nPrefMaxLen, nEntriesRead, _
nTotalEntries, nServerType, pszDomain, nResumeHandle)
If ((nRet = ERROR_SUCCESS) Or (nRet = ERROR_MORE_DATA)) And (nEntriesRead > 0) Then
TempBufPtr = BufPtr
For i = 1 To nEntriesRead
RtlMoveMemory ServerInfo, TempBufPtr, SIZE_SI_101
lst.AddItem PointerToString(ServerInfo.lpszServerName)
TempBufPtr = TempBufPtr + SIZE_SI_101
Next i
Else
MsgBox "NetServerEnum failed: " & nRet
End If
NetApiBufferFree (BufPtr)
Loop While nEntriesRead < nTotalEntries
End Sub

[/vb]

just put a list box on the form called lst
and a text box called txtMsg
 
Thanx Guys sooo much for the quick responses. dk87 I tried your suggestion. I had to modify it a bit to include PC ID's, because I do not have access to User Names, which is ok with me.

Here is what I coded, but no msg is forthcoming. How do I incorporate the PC ID?
If Cusers > 0 Then
' Print computer names to Debug window.
For intLooper = 0 To Cusers - 1
Debug.Print "User"; intLooper + 1; ":"; _
lpszUserBuffer(intLooper)
'Shell ("Net Send Trudye Hello!")
Shell ("net Send lpszUserBuffer(intLooper) Please Log off")

Next
End If
Thank again,
Trudye
 
I'm not sure what your machine names are, but it looks like you are sending a variable rather than a machine name.

If, for example, your machine names are lpszUserBuffer(1) and
lpszUserBuffer(2) (I know, they're not, but this is for illustration purposes):


Dim strCommand As String
Dim intLooper As Integer

For intLooper = 1 To 2


strCommand = "net Send lpszUserBuffer(" & intLooper & ") Please Log off"

Shell (strCommand)

Next intLooper
 
Thanx I figured it out, I used:
Shell ("net Send " & lpszUserBuffer(intLooper) & " ONLY TESTING: Please Log off of the Recovery database")

Pretty much what you did

Thanx again,
Trudye
 
One more question. Is there a way to exclude the current PC from getting the msg? In other words where is my PC ID stored?

I searched the registry and did not get a hit.

Thanx
Trudye
 
Maybe:

HKLM\SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName

 
Thanx dk87 I'll try it and let you know.

Be well,
Trudye
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top