![]() |
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! |
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! |
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! |
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! |
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! |
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 |
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 |
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 |
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! |
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 |
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