無聲地在後臺ping

當我執行下面的代碼時，一個黑色的命令窗口打開，它將閃爍，直到所有設備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

來源

2016-12-29 DK JOSHI

嘗試使用'strPingResult =殼牌代碼（「平-n 2 -w 5」＆strTarget，vbHide）' –

我可以在哪裏插入它，或者我需要替換某些東西。先生，我是vba新手。 –

替換你的'Set wshExec = wshShell.exec（「ping -n 2 -w 5」＆strTarget）'並且'strPingResult = LCase（wshExec.stdout.readall）' –

以下是一個

子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

來源

2017-01-05 18:07:33

無聲地在後臺ping

回答

相關問題