无声地在后台ping

Question

当我执行下面的代码时，一个黑色的命令窗口打开，它将闪烁，直到所有设备ping通。我如何静静地运行它？

Sub PING() 

Application.ScreenUpdating = False 
Dim strTarget, strPingResult, strInput, wshShell, wshExec 

With Sheets(1) 
    shlastrow = .Cells(Rows.Count, "B").End(x1up).Row 
    Set shrange = .Range("B3:B7" & shlastrow) 
End With 

For Each shCell In shrange 
    strInput = shCell.Text 

    If strInput <> "" Then 
     strTarget = strInput 
     setwshshell = CreateObject("wscript.shell") 

     Set wshExec = wshShell.exec("ping -n 2 -w 5 " & strTarget) 
     strPingResult = LCase(wshExec.stdout.readall) 

     If InStr(strPingResult, "reply from") Then 
      shCell.Offset(0, 1).Value = "Reachable" 
      shCell.Offset(0, 2).Value = "Time" 
     Else 
      shCell.Offset(0, 1).Value = "UnReachable" 
      shCell.Offset(0, 2).Value = "Reachable" 
     End If 
    End If 

Next shCell 

End Sub 

Answer 1

以下是一个

子Do_ping（）

With ActiveWorkbook.Worksheets(1) 
    n = 0 
    Row = 2 
    Do 
     If .Cells(Row, 1) <> "" Then 
     If IsConnectible(.Cells(Row, 1), 2, 100) = True Then 
     n = n + 1 
     Cells(Row, 1).Interior.Color = RGB(0, 255, 0) 
     Cells(Row, 1).Font.FontStyle = "bold" 
     Cells(Row, 1).Font.Size = 14 
     Cells(Row, 2).Interior.Color = RGB(0, 255, 0) 
     Cells(Row, 2).Value = Time 
     'Call siren 
     Else: 
     n = n + 1 
     'Cells(Row, 2).Formula = "=NOW()-" & CDbl(Now()) 
     Cells(Row, 1).Interior.Color = RGB(255, 0, 0) 
     Cells(Row, 3).Value = DateDiff("h:mm:ss", Cells(Row, 2), Now()) 
     End If 

     End If 
     Row = Row + 1 
    Loop Until .Cells(Row, 1) = "" 
    End With 
End Sub 

Function IsConnectible(sHost, iPings, iTO) 
    ' Returns True or False based on the output from ping.exe 
    ' Works an "all" WSH versions 
    ' sHost is a hostname or IP 
    ' iPings is number of ping attempts 
    ' iTO is timeout in milliseconds 
    ' if values are set to "", then defaults below used 

    Dim nRes 
    If iPings = "" Then iPings = 1 ' default number of pings 
    If iTO = "" Then iTO = 550  ' default timeout per ping 
    With CreateObject("WScript.Shell") 
    nRes = .Run("%comspec% /c ping.exe -n " & iPings & " -w " & iTO _ 
      & " " & sHost & " | find ""TTL="" > nul 2>&1", 0, True) 
    End With 
    IsConnectible = (nRes = 0) 

End Function