/ / ping silenciosamente em segundo plano - excel, vba

ping silenciosamente em segundo plano - excel, vba

Quando executo o código a seguir, uma janela de comando preta é aberta e pisca até a hora em que todos os dispositivos são exibidos. Como posso executá-lo silenciosamente?

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

Respostas:

0 para resposta № 1

Aqui está o código para isso

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