平静地在后台ping

当我执行下面的代码，一个黑色的命令窗口打开，它会闪烁，直到所有的设备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

这是这个代码

Sub 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