excel - 在后台静默 ping

Question

当我执行以下代码时，会打开一个黑色命令窗口，并且它会闪烁，直到所有设备都执行 ping 操作。我怎样才能静默运行它？

Sub PING()

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

With Sheets(1)
    shlastrow = .Cells(Rows.Count, "B").End(xlUp).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