VBA_EXCEL : Ping d'adresse IP

Voici une façon de procéder, publié par Denis Pasquier :


Effectuer Un Ping Dans Excel - à copier dans un module standard.

' Pasquier Denis 03.2002
' Controle si num ip est accessible
' Comme la commande ping

Option Explicit
Const SOCKET_ERROR = 0

Private Type WSAdata
wVersion As Integer
wHighVersion As Integer
szDescription(0 To 255) As Byte
szSystemStatus(0 To 128) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type

Private Type Hostent
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type

Private Type IP_OPTION_INFORMATION
TTL As Byte
Tos As Byte
Flags As Byte
OptionsSize As Long
OptionsData As String * 128
End Type

Private Type IP_ECHO_REPLY
Address(0 To 3) As Byte
Status As Long
RoundTripTime As Long
DataSize As Integer
Reserved As Integer
data As Long
Options As IP_OPTION_INFORMATION
End Type

Private Declare Function GetHostByName Lib _
"wsock32.dll" Alias "gethostbyname" _
(ByVal HostName As String) As Long

Private Declare Function WSAStartup Lib _
"wsock32.dll" (ByVal wVersionRequired&, _
lpWSAdata As WSAdata) As Long

Private Declare Function WSACleanup Lib "wsock32.dll" _
() As Long

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, _
ByVal cbCopy As Long)

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

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

Private Declare Function IcmpSendEcho Lib "ICMP" _
(ByVal IcmpHandle As Long, ByVal DestAddress As Long, _
ByVal RequestData As String, _
ByVal RequestSize As Integer, RequestOptns As _
IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, _
ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean


Function IP_connect(HostName)

'Dim HostName

'HostName = ActiveCell.Value

Dim hFile As Long, lpWSAdata As WSAdata

Dim hHostent As Hostent, AddrList As Long

Dim Address As Long, rIP As String

Dim OptInfo As IP_OPTION_INFORMATION

Dim EchoReply As IP_ECHO_REPLY

Call WSAStartup(&H101, lpWSAdata)

If GetHostByName(HostName + _
String(64 - Len(HostName), 0)) _
<> SOCKET_ERROR Then

CopyMemory hHostent.h_name, _
ByVal GetHostByName(HostName + _
String(64 - Len(HostName) _
, 0)), Len(hHostent)

CopyMemory AddrList, ByVal hHostent.h_addr_list, 4

CopyMemory Address, ByVal AddrList, 4

End If

hFile = IcmpCreateFile()

If hFile = 0 Then

'MsgBox "Unable to Create File Handle"
IP_connect = "Unable to Create File Handle"
Exit Function

End If

OptInfo.TTL = 255

If IcmpSendEcho(hFile, Address, _
String(32, "A"), 32, OptInfo, EchoReply, _
Len(EchoReply) + 8, 2000) Then

rIP = CStr(EchoReply.Address(0)) + _
"." + CStr(EchoReply.Address(1)) + "." + _
CStr(EchoReply.Address(2)) + "." + _
CStr(EchoReply.Address(3))

Else

'MsgBox "Timeout"
IP_connect = "Timeout"
End If

If EchoReply.Status = 0 Then

'MsgBox "Reply from " + HostName + " (" + rIP _
+ ") recieved after " + _
Trim$(CStr(EchoReply.RoundTripTime)) + "ms"


IP_connect = "Reply from " + HostName + " (" + rIP _
+ ") recieved after " + _
Trim$(CStr(EchoReply.RoundTripTime)) + "ms"



Else

'MsgBox "Failure ..."
IP_connect = "Failure ..."
End If

Call IcmpCloseHandle(hFile)

Call WSACleanup

End Function

Sub Boucle_sur_selection()
Dim Sel As Range
Dim Cel As Range
Dim message
Dim nF As Worksheet

Set Sel = Selection
Set nF = ActiveWorkbook.Sheets.Add

For Each Cel In Sel
message = IP_connect(Cel.Value)
ActiveCell = Cel
ActiveCell.Offset(0, 1) = message
ActiveCell.Offset(0, 2) = Time
ActiveCell.Offset(1, 0).Range("A1").Select
Next Cel

Columns("A:C").EntireColumn.AutoFit
Set Sel = Nothing
Set nF = Nothing

End Sub




"Jordane" <Jordane@discussions.microsoft.com> a écrit dans le message de news:
0ADA1997-B8E6-4504-AF05-AFB82943D477@microsoft.com...
Bonjour,

Je souhaite pouvoir faire ( depuis excel ) un Ping d'adresses contenues dans
des cellules ( A1 : A8) afin de tester la connexion à des ordinateurs
distants.
Le résultat => " ping ok " ou "ping Ko" devra apparaitre dans une autre
colonne.( B1:B8)

J'ai vu sur internet que je pourrai utiliser une commande shell mais je ne
sais pas comment interpreter le résultat ( retval) :
toexe = "c:windowssystem32ping.exe -t" & " " & IP_a_tester
RetVal = Shell(toexe, 1)

D'avance Merci.