Ping an IP (using the IP from a cell)

[Chris424]

Does anyone know how to Ping an IP (using the IP from a cell)

so if A1 is 10.65.1.1
Ping 10.65.1.1 and give a msgbox saying "sucessful" or "not successful"

I can do it using VBScript but cant work out how to do it in VBA.

On Error Resume Next

Dim strTarget, strPingResults, strInput			'Declares the variables
strInput = InputBox ("Enter IP Address to Ping")	'Uses an InputBox to gather IP Address
If strInput = "" Then
WScript.Quit
WScript.End
Else
strTarget = strInput 					'Uses the IP address from the InputBox

Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshExec = WshShell.Exec("ping -n 3 -w 2000 " & strTarget) 'send 3 echo requests, waiting 2secs each
strPingResults = LCase(WshExec.StdOut.ReadAll)
If InStr(strPingResults, "reply from") Then
  WScript.Echo strTarget & " responded to ping."  
Else
  WScript.Echo strTarget & " did not respond to ping."
End If
End If
WScript.Quit
WScript.End

I have searched but cant find anything that is close to what I need.

Any help would be fab

[romperstomper]

The literal equivalent is not that different:

Sub PingIt()

Dim strTarget, strPingResults, strInput, wshShell, WshExec        'Declares the variables
strInput = Range("A1").text
If strInput <> "" Then
   strTarget = strInput                'Uses the IP address from the cell   
   Set wshShell = CreateObject("WScript.Shell")
   Set WshExec = wshShell.Exec("ping -n 3 -w 2000 " & strTarget) 'send 3 echo requests, waiting 2secs each
   strPingResults = LCase(WshExec.StdOut.ReadAll)
   If InStr(strPingResults, "reply from") Then
     MsgBox strTarget & " responded to ping."
   Else
     MsgBox strTarget & " did not respond to ping."
   End If
End If
End Sub

[Chris424]

That is perfect! You are brilliant!

Thank you soooooo much

[romperstomper]

Hey Donkey () - how's tricks? Any plans for a foray into London anytime soon?

[DonkeyOte]

Hey! No immediate plans to leave deepest darkest Suffolk but you never know Trust the family is doing well!

(hijack over before I have to infract myself!)

[Chris424]

I know I am being picky now

Is there any way to stop the black box popping up? Or have it minimized so it doesnt show?

I have attached a screenshot of what I mean

Thanks again for all your help

[romperstomper]

Not with that method, I don't think. You could use API functions instead - simplistic version below. The Ping function returns True if successful:

Option Explicit

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

Private Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal cp As String) 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 Type IP_OPTION_INFORMATION
   Ttl             As Byte
   Tos             As Byte
   Flags           As Byte
   OptionsSize     As Byte
   OptionsData     As Long
End Type
 
Public Type ICMP_ECHO_REPLY
   address         As Long
   Status          As Long
   RoundTripTime   As Long
   DataSize        As Long
   Reserved        As Integer
   ptrData                 As Long
   Options        As IP_OPTION_INFORMATION
   data            As String * 250
End Type

Public Function ping(strAddress As String, Reply As ICMP_ECHO_REPLY) As Boolean

Dim hIcmp As Long
Dim lngAddress As Long
Dim lngTimeOut As Long
Dim strSendText As String

'Short string of data to send
strSendText = "blah"

' timeout value in ms
lngTimeOut = 1000

'Convert string address to a long
lngAddress = inet_addr(strAddress)

If (lngAddress <> -1) And (lngAddress <> 0) Then
        
    hIcmp = IcmpCreateFile()
    
    If hIcmp <> 0 Then
        'Ping the destination IP
        Call IcmpSendEcho(hIcmp, lngAddress, strSendText, Len(strSendText), 0, Reply, Len(Reply), lngTimeOut)

        'Reply status
        ping = (Reply.Status = 0)
        
        'Close the Icmp handle.
        IcmpCloseHandle hIcmp
    Else
        ping = False
    End If
Else
    ping = False
End If

End Function

Sub TestPinger()
   Dim blnResponse As Boolean, lngStatus As ICMP_ECHO_REPLY
   blnResponse = ping("10.100.1.1", lngStatus)
   Debug.Print blnResponse
End Sub