使用 VBA 代码 Ping IP 地址并在 Excel 中返回结果
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/21020077/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Ping IP Address with VBA code and return results in Excel
提问by Andy
I have some visual basic code (see below) that tests an IP connection in column B (of an excel spreadsheet) and puts whether or not it is connected or un-reachable in column c, I was just wondering if you could help me I would like it to be green if 'connected', and any other result would be red.
我有一些可视化的基本代码（见下文），用于测试 B 列（Excel 电子表格的）中的 IP 连接，并将它是否已连接或无法访问列在 c 列中，我只是想知道您是否可以帮助我我如果“已连接”，则希望它是绿色的，而任何其他结果都是红色的。
Also, could this script be run automatically on an hourly or daily basis?
另外，这个脚本可以每小时或每天自动运行吗？
Many Thanks, Andy
非常感谢，安迪
Function GetPingResult(Host)
Dim objPing As Object
Dim objStatus As Object
Dim strResult As String
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
ExecQuery("Select * from Win32_PingStatus Where Address = '" & Host & "'")
For Each objStatus In objPing
Select Case objStatus.StatusCode
Case 0: strResult = "Connected"
Case 11001: strResult = "Buffer too small"
Case 11002: strResult = "Destination net unreachable"
Case 11003: strResult = "Destination host unreachable"
Case 11004: strResult = "Destination protocol unreachable"
Case 11005: strResult = "Destination port unreachable"
Case 11006: strResult = "No resources"
Case 11007: strResult = "Bad option"
Case 11008: strResult = "Hardware error"
Case 11009: strResult = "Packet too big"
Case 11010: strResult = "Request timed out"
Case 11011: strResult = "Bad request"
Case 11012: strResult = "Bad route"
Case 11013: strResult = "Time-To-Live (TTL) expired transit"
Case 11014: strResult = "Time-To-Live (TTL) expired reassembly"
Case 11015: strResult = "Parameter problem"
Case 11016: strResult = "Source quench"
Case 11017: strResult = "Option too big"
Case 11018: strResult = "Bad destination"
Case 11032: strResult = "Negotiating IPSEC"
Case 11050: strResult = "General failure"
Case Else: strResult = "Unknown host"
End Select
GetPingResult = strResult
Next
Set objPing = Nothing
End Function
Sub GetIPStatus()
Dim Cell As Range
Dim ipRng As Range
Dim Result As String
Dim Wks As Worksheet
Set Wks = Worksheets("Sheet1")
Set ipRng = Wks.Range("B3")
Set RngEnd = Wks.Cells(Rows.Count, ipRng.Column).End(xlUp)
Set ipRng = IIf(RngEnd.Row < ipRng.Row, ipRng, Wks.Range(ipRng, RngEnd))
For Each Cell In ipRng
Result = GetPingResult(Cell)
Cell.Offset(0, 1) = Result
Next Cell
End Sub
回答by Dick Kusleika
You don't need code for this. Turn all the cells red, then add conditional formatting to make it green when you want.
您不需要为此编写代码。将所有单元格变为红色，然后根据需要添加条件格式以使其变为绿色。
Home > Conditional Formatting > New Rule > Use a formula...
主页 > 条件格式 > 新规则 > 使用公式...
=C2="Connected"
and format to green. If you want to do it in code, you can add some lines in your For Each loop
并格式化为绿色。如果你想在代码中做到这一点，你可以在你的 For Each 循环中添加一些行
If Result = "Connected" Then
Cell.Offset(0,1).Font.Color = vbGreen
Else
Cell.Offset(0,1).Font.Color = vbRed
End If
回答by thunderblaster
To have this run automatically at certain intervals, check out this link.
要以特定时间间隔自动运行此程序，请查看此链接。
Here's the relevant code:
这是相关的代码：
Public dTime As Date
Dim lNum As Long
Sub RunOnTime()
dTime = Now + TimeSerial(0, 0, 10) 'Change this to set your interval
Application.OnTime dTime, "RunOnTime"
lNum = lNum + 1
If lNum = 3 Then
Run "CancelOnTime" 'You could probably omit an end time, but I think the program would eventually crash
Else
MsgBox lNum
End If
End Sub
Sub CancelOnTime()
Application.OnTime dTime, "RunOnTime", , False
End Sub
I would recommend including a ThisWorkbook.Saveline as I can't speak to how long this will run without crashing, and I would imagine you could see problems if you left it for days at a time.
我建议包括一条ThisWorkbook.Save线，因为我无法确定这将运行多长时间而不会崩溃，我想如果你一次离开它几天，你会看到问题。
