Excel VBA Ping一個設備

Question

我一直在尋找一種方式來ping設備在網絡上沒有脫殼（不真的要用戶看到的東西試圖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

沒關係發現我的回答如下代碼的人同樣的事情後

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