Excel VBA Ping一个设备

我一直在寻找一种方法来pingnetworking上的一个设备，而不会发生shelling（不真的希望用户看到的东西只能ping通结果），我想像下面的过程。

Sub pingdevice(myip As String) Dim Pingable As Boolean 'Code here to ping device using myip variable and return result true or false to pingable variable If Pingable = True Then 'Do Something Else msgbox "Device not pingable" End IF End Sub 

Answer 1

没关系在同一件事情后面find我的答案代码

 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 pingable As Boolean, lngStatus As ICMP_ECHO_REPLY pingable = Ping("192.168.1.101", lngStatus) MsgBox pingable End Sub