Ping from Excel

Can you post the code that you have?

If there are any functions in there, then for 64-bit you need to use PtrSafe in the declarations.

Smitty,
Sorry fo rmy delay, below is the API function i was trying to use - basically, I have a list of IPs in column A, I would like to launch a marcro to ping each IP down the various rows and return a value in the adjacent cell in column B (red or green, or Up/down, etc...) at the very bottom of this post is a bit of code i use to ping an IP from a single cell, but it doesnt move on to the next nor provide any result in column B.

Option ExplicitPrivate Declare Function IcmpCreateFile Lib "icmp.dll" () As LongPrivate Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal cp As String) As LongPrivate Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As LongPrivate 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 LongEnd 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 * 250End TypePublic Function ping(strAddress As String, Reply As ICMP_ECHO_REPLY) As BooleanDim hIcmp As LongDim lngAddress As LongDim lngTimeOut As LongDim strSendText As String'Short string of data to sendstrSendText = "blah"' timeout value in mslngTimeOut = 1000'Convert string address to a longlngAddress = 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 IfElse ping = FalseEnd IfEnd FunctionSub TestPinger() Dim blnResponse As Boolean, lngStatus As ICMP_ECHO_REPLY blnResponse = ping("10.100.1.1", lngStatus) Debug.Print blnResponseEnd Sub</PRE>

Ping IP from Cell

Option ExplicitPrivate Declare Function IcmpCreateFile Lib "icmp.dll" () As LongPrivate Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal cp As String) As LongPrivate Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As LongPrivate 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 LongEnd 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 * 250End TypePublic Function ping(strAddress As String, Reply As ICMP_ECHO_REPLY) As BooleanDim hIcmp As LongDim lngAddress As LongDim lngTimeOut As LongDim strSendText As String'Short string of data to sendstrSendText = "blah"' timeout value in mslngTimeOut = 1000'Convert string address to a longlngAddress = 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 IfElse ping = FalseEnd IfEnd FunctionSub TestPinger() Dim blnResponse As Boolean, lngStatus As ICMP_ECHO_REPLY blnResponse = ping("10.100.1.1", lngStatus) Debug.Print blnResponseEnd Sub</PRE>

Smitty,
Thank you! adding the PtrSafe resolved my issue! Seems to be working fine now. I appreciate it!

Option Explicit

Private Declare PtrSafe Function GetRTTAndHopCount Lib "iphlpapi.dll" _
(ByVal iDestIPAddr As Long, _
ByRef iHopCount As Long, _
ByVal iMaxHops As Long, _
ByRef iRTT As Long) As Long

Private Declare PtrSafe Function inet_addr Lib "wsock32.dll" _
(ByVal cp As String) As Long

Sub TestPings()
Dim cell As Range
Dim astr() As String

For Each cell In Intersect(ActiveSheet.UsedRange, Columns(1))
astr = Split(cell.Value, ".")
If UBound(astr) = 3 Then
cell.Select
cell.Interior.ColorIndex = xlNone
cell.Interior.ColorIndex = IIf(Ping(cell.Text, 20), 4, 3)
End If
Next
End Sub

Public Function Ping(sIPadr As String, iMaxHops As Long) As Boolean

' Based on an article on CodeGuru by Bill Nolde
' Implemented in VBA in Nov 2002 by G. Wirth, Ulm, Germany

Const SUCCESS As Long = 1

Dim iIPadr As Long
Dim iHopCount As Long
Dim iRTT As Long

iIPadr = inet_addr(sIPadr)
Ping = (GetRTTAndHopCount(iIPadr, iHopCount, iMaxHops, iRTT) = SUCCESS)

Debug.Print "IP Address ....... " & iIPadr & vbLf _
& "HopCount ......... " & iHopCount & vbLf _
& "Round trip, ms ... " & iRTT
End Function

Re: Ping from Excel רועי זזון

פינג מאקסל לרשימת מחשבים
Write in column A 1 Computer Name Write in column B 1 IP/HostName
At the end of ip or addres on column A Write endscript
Then create a new macro
copy this :
Function sPing(sHost) As String
On Error Resume Next
sHost = Trim(sHost)
Dim ipaddress As String
Dim username As String
Dim computername As String
Dim Model As String
Dim memory As Long
Dim oPing As Object, oRetStatus As Object
Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}")
Set oPing = oPing.execquery("select * from win32_pingstatus where address ='" & sHost & "'")
For Each oRetStatus In oPing
If IsNull(oRetStatus.statuscode) Then
sPing = "Dead"
ElseIf oRetStatus.statuscode = 11010 Then
sPing = "Request Timed Out"
ElseIf oRetStatus.statuscode = 11013 Then
sPing = "Destination Host Unreachable"
Else
sPing = "Alive"
End If
Next
Set oPing = Nothing
Set oRetStatus = Nothing
Set oUsername = Nothing
End Function
Sub GetComputerHardwareanduser()
Application.DisplayAlerts = False
On Error Resume Next
Dim applicationobject As Object
i = 2
Do Until Cells(i, 1) = "endscript"
If Cells(i, 1) <> "" Then
If Cells(i, 2) = "Request Timed Out" Or Cells(i, 2) = "" Or Cells(i, 2) = "Dead" Then
Cells(i, 2) = sPing(Cells(i, 1))
End If
End If
i = i + 1
Loop
Set applicationobject = Nothing
End Sub
then insert the ip or ? & run the macro