ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Execute a ping command (https://www.excelbanter.com/excel-programming/346204-execute-ping-command.html)

Significent

Execute a ping command
 
How do I pass the contents of the current cell as a parm to the shell command?

Sub Macro1()
Shell "ping.exe -t Current cell value here as a parm"
End Sub

Thanks!




Bob Phillips[_6_]

Execute a ping command
 
Probably

Shell "ping.exe -t " & Activecell.Value

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Significent" wrote in message
...
How do I pass the contents of the current cell as a parm to the shell

command?

Sub Macro1()
Shell "ping.exe -t Current cell value here as a parm"
End Sub

Thanks!






Jim Thomlinson[_4_]

Execute a ping command
 
This is not my code but if I recall correctly it executes a ping command...

Option Explicit
Private Const IP_SUCCESS As Long = 0
Private Const PING_TIMEOUT As Long = 500
Private Const WS_VERSION_REQD As Long = &H101
Private Const INADDR_NONE As Long = &HFFFFFFFF
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128

Private Type ICMP_OPTIONS
Ttl As Byte
Tos As Byte
Flags As Byte
OptionsSize As Byte
OptionsData As Long
End Type

Private Type ICMP_ECHO_REPLY
Address As Long
status As Long
RoundTripTime As Long
DataSize As Long 'formerly integer
'Reserved As Integer
DataPointer As Long
Options As ICMP_OPTIONS
Data As String * 250
End Type

Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type

Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long

Private Declare Function IcmpCloseHandle Lib "icmp.dll" _
(ByVal IcmpHandle As Long) As Long

Private Declare Function IcmpSendEcho Lib "icmp.dll" _
(ByVal IcmpHandle As Long, _
ByVal DestinationAddress As Long, _
ByVal RequestData As String, _
ByVal RequestSize As Long, _
ByVal RequestOptions As Long, _
ReplyBuffer As ICMP_ECHO_REPLY, _
ByVal ReplySize As Long, _
ByVal Timeout As Long) As Long

Private Declare Function WSAGetLastError Lib "wsock32" () As Long

Private Declare Function WSAStartup Lib "wsock32" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSADATA) As Long

Private Declare Function WSACleanup Lib "wsock32" () As Long

Private Declare Function gethostname Lib "wsock32" _
(ByVal szHost As String, _
ByVal dwHostLen As Long) As Long

Private Declare Function gethostbyname Lib "wsock32" _
(ByVal szHost As String) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(xDest As Any, _
xSource As Any, _
ByVal nbytes As Long)

Private Declare Function inet_addr Lib "wsock32" _
(ByVal s As String) As Long


Function PingComputer(ByVal strIPAddress As String) As Long

Dim ECHO As ICMP_ECHO_REPLY
Dim pos As Long
Dim lResult As Long

Dim str2 As String

If SocketsInitialize() Then

str2 = "test"

'ping the IP by passing the address,
'text to send, and the ECHO structure.
lResult = Ping((strIPAddress), (str2), ECHO)

If Left$(ECHO.Data, 1) < Chr$(0) Then
pos = InStr(ECHO.Data, Chr$(0))
End If

SocketsCleanup

Else

'MsgBox "Windows Sockets for 32 bit Windows " & _
"environments is not successfully responding."

End If

PingComputer = lResult

End Function

Private Function Ping(sAddress As String, _
sDataToSend As String, _
ECHO As ICMP_ECHO_REPLY) As Long

'If Ping succeeds :
'.RoundTripTime = time in ms for the ping to complete,
'.Data is the data returned (NULL terminated)
'.Address is the Ip address that actually replied
'.DataSize is the size of the string in .Data
'.Status will be 0
'If Ping fails .Status will be the error code

Dim hPort As Long
Dim dwAddress As Long

'convert the address into a long representation
dwAddress = inet_addr(sAddress)

'if a valid address..
If dwAddress < INADDR_NONE Then

'open a port
hPort = IcmpCreateFile()

'and if successful,
If hPort Then

'ping it.
Call IcmpSendEcho(hPort, _
dwAddress, _
sDataToSend, _
Len(sDataToSend), _
0, _
ECHO, _
Len(ECHO), _
PING_TIMEOUT)

'return the status as ping succes and close
Ping = ECHO.status
Call IcmpCloseHandle(hPort)

End If

Else
'the address format was probably invalid
Ping = INADDR_NONE

End If

End Function

Private Sub SocketsCleanup()

If WSACleanup() < 0 Then
MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
End If

End Sub

Private Function SocketsInitialize() As Boolean

Dim WSAD As WSADATA

SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS

End Function


'Run this Like this:
'
'ActiveCell.Value = PingComputer(Cells(ActiveCell.Row, 1).Value)



--
HTH...

Jim Thomlinson


"Significent" wrote:

How do I pass the contents of the current cell as a parm to the shell command?

Sub Macro1()
Shell "ping.exe -t Current cell value here as a parm"
End Sub

Thanks!




Significent

Execute a ping command
 
Bob:

Your suggestion worked fine except the resulting command window was not in
focus by default. How do I force it to the foreground?

Thanks,
Tim

"Bob Phillips" wrote:

Probably

Shell "ping.exe -t " & Activecell.Value

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Significent" wrote in message
...
How do I pass the contents of the current cell as a parm to the shell

command?

Sub Macro1()
Shell "ping.exe -t Current cell value here as a parm"
End Sub

Thanks!







Significent

Execute a ping command
 
Jim:

I didn't give this a try yet as the simpler approach that Bob suggested
seems like it will do the trick. Thanks for taking the time to post your
solution. I may try it later to see if it provides an advantage over the
"simple" approach.

Thanks,
Tim

"Jim Thomlinson" wrote:

This is not my code but if I recall correctly it executes a ping command...

Option Explicit
Private Const IP_SUCCESS As Long = 0
Private Const PING_TIMEOUT As Long = 500
Private Const WS_VERSION_REQD As Long = &H101
Private Const INADDR_NONE As Long = &HFFFFFFFF
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128

Private Type ICMP_OPTIONS
Ttl As Byte
Tos As Byte
Flags As Byte
OptionsSize As Byte
OptionsData As Long
End Type

Private Type ICMP_ECHO_REPLY
Address As Long
status As Long
RoundTripTime As Long
DataSize As Long 'formerly integer
'Reserved As Integer
DataPointer As Long
Options As ICMP_OPTIONS
Data As String * 250
End Type

Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type

Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long

Private Declare Function IcmpCloseHandle Lib "icmp.dll" _
(ByVal IcmpHandle As Long) As Long

Private Declare Function IcmpSendEcho Lib "icmp.dll" _
(ByVal IcmpHandle As Long, _
ByVal DestinationAddress As Long, _
ByVal RequestData As String, _
ByVal RequestSize As Long, _
ByVal RequestOptions As Long, _
ReplyBuffer As ICMP_ECHO_REPLY, _
ByVal ReplySize As Long, _
ByVal Timeout As Long) As Long

Private Declare Function WSAGetLastError Lib "wsock32" () As Long

Private Declare Function WSAStartup Lib "wsock32" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSADATA) As Long

Private Declare Function WSACleanup Lib "wsock32" () As Long

Private Declare Function gethostname Lib "wsock32" _
(ByVal szHost As String, _
ByVal dwHostLen As Long) As Long

Private Declare Function gethostbyname Lib "wsock32" _
(ByVal szHost As String) As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(xDest As Any, _
xSource As Any, _
ByVal nbytes As Long)

Private Declare Function inet_addr Lib "wsock32" _
(ByVal s As String) As Long


Function PingComputer(ByVal strIPAddress As String) As Long

Dim ECHO As ICMP_ECHO_REPLY
Dim pos As Long
Dim lResult As Long

Dim str2 As String

If SocketsInitialize() Then

str2 = "test"

'ping the IP by passing the address,
'text to send, and the ECHO structure.
lResult = Ping((strIPAddress), (str2), ECHO)

If Left$(ECHO.Data, 1) < Chr$(0) Then
pos = InStr(ECHO.Data, Chr$(0))
End If

SocketsCleanup

Else

'MsgBox "Windows Sockets for 32 bit Windows " & _
"environments is not successfully responding."

End If

PingComputer = lResult

End Function

Private Function Ping(sAddress As String, _
sDataToSend As String, _
ECHO As ICMP_ECHO_REPLY) As Long

'If Ping succeeds :
'.RoundTripTime = time in ms for the ping to complete,
'.Data is the data returned (NULL terminated)
'.Address is the Ip address that actually replied
'.DataSize is the size of the string in .Data
'.Status will be 0
'If Ping fails .Status will be the error code

Dim hPort As Long
Dim dwAddress As Long

'convert the address into a long representation
dwAddress = inet_addr(sAddress)

'if a valid address..
If dwAddress < INADDR_NONE Then

'open a port
hPort = IcmpCreateFile()

'and if successful,
If hPort Then

'ping it.
Call IcmpSendEcho(hPort, _
dwAddress, _
sDataToSend, _
Len(sDataToSend), _
0, _
ECHO, _
Len(ECHO), _
PING_TIMEOUT)

'return the status as ping succes and close
Ping = ECHO.status
Call IcmpCloseHandle(hPort)

End If

Else
'the address format was probably invalid
Ping = INADDR_NONE

End If

End Function

Private Sub SocketsCleanup()

If WSACleanup() < 0 Then
MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
End If

End Sub

Private Function SocketsInitialize() As Boolean

Dim WSAD As WSADATA

SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS

End Function


'Run this Like this:
'
'ActiveCell.Value = PingComputer(Cells(ActiveCell.Row, 1).Value)



--
HTH...

Jim Thomlinson


"Significent" wrote:

How do I pass the contents of the current cell as a parm to the shell command?

Sub Macro1()
Shell "ping.exe -t Current cell value here as a parm"
End Sub

Thanks!




Leith Ross[_297_]

Execute a ping command
 

Hello Significant,

Here is a shorter API method that will Ping the computer for you. Add a
VBA module to your project and copy this code into it.


Code:
--------------------
Public Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long

Public Function Ping(Ip_Address As String) As Boolean

Dim Result

Result = ShellExecute(0&, vbNullString, "ping.exe", Ip_Address, vbNullString, 1&)

If Result 32 Then
Ping = True
Else
Ping = False
End If

End Function

--------------------

Sincerely,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=487014


Significent

Execute a ping command
 
Leith:

Your short version seems to function pretty well. I tried Jims;but, I'm not
sure it's working properly.

Thanks for you help,
Tim

"Leith Ross" wrote:


Hello Significant,

Here is a shorter API method that will Ping the computer for you. Add a
VBA module to your project and copy this code into it.


Code:
--------------------
Public Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long

Public Function Ping(Ip_Address As String) As Boolean

Dim Result

Result = ShellExecute(0&, vbNullString, "ping.exe", Ip_Address, vbNullString, 1&)

If Result 32 Then
Ping = True
Else
Ping = False
End If

End Function

--------------------

Sincerely,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=487014



Significent

Execute a ping command
 
Leith:

After a little playing, I discovered the function returns TRUE reguardless
whether or not the ping was sucessful?

Thanks,
Tim

"Leith Ross" wrote:


Hello Significant,

Here is a shorter API method that will Ping the computer for you. Add a
VBA module to your project and copy this code into it.


Code:
--------------------
Public Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long

Public Function Ping(Ip_Address As String) As Boolean

Dim Result

Result = ShellExecute(0&, vbNullString, "ping.exe", Ip_Address, vbNullString, 1&)

If Result 32 Then
Ping = True
Else
Ping = False
End If

End Function

--------------------

Sincerely,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=487014



Significent

Execute a ping command
 
Bob:

After a little playing, this seemed to work perfectly:

Shell ("ping.exe -t " & ActiveCell.Value), vbNormalFocus

Thanks for you help!
Tim

"Bob Phillips" wrote:

Probably

Shell "ping.exe -t " & Activecell.Value

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Significent" wrote in message
...
How do I pass the contents of the current cell as a parm to the shell

command?

Sub Macro1()
Shell "ping.exe -t Current cell value here as a parm"
End Sub

Thanks!







Leith Ross[_300_]

Execute a ping command
 

Hello Tim,

Sorry about that. I was on auto pilot. I have used that API so many
times, I forgot that you wanted the Ping status, and not if the
Ping.exe module actually executed the command. Jim's code certainly
will tell you the Ping status. What are not sure about with Jim's
code?

Sincerely,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=487014


Significent

Execute a ping command
 
Leith:

Not to worry. I'm a step below novice with VB stuff. I played a little with
Bob Phillips suggestion and got it working from a macro just the way I had
originally envisioned it.

Shell ("ping.exe -t " & ActiveCell.Value), vbNormalFocus

Thanks again for your help,
Tim

"Leith Ross" wrote:


Hello Tim,

Sorry about that. I was on auto pilot. I have used that API so many
times, I forgot that you wanted the Ping status, and not if the
Ping.exe module actually executed the command. Jim's code certainly
will tell you the Ping status. What are not sure about with Jim's
code?

Sincerely,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=487014




All times are GMT +1. The time now is 05:30 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com