我有一些 Visual Basic 代码(见下文),用于测试 B 列(Excel 电子表格)中的 IP 连接,并将其是否已连接或无法访问放在 C 列中,我只是想知道您是否可以帮助我,如果“已连接”,我希望它是绿色的,任何其他结果都是红色的。
此外,这个脚本可以每小时或每天自动运行吗?
非常感谢, 安迪
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
最佳答案
您不需要为此编写代码。将所有单元格变为红色,然后添加条件格式以在需要时将其变为绿色。
主页 > 条件格式 > 新规则 > 使用公式...
=C2="Connected"
并将格式设置为绿色。如果您想在代码中执行此操作,可以在 For Each 循环中添加一些行
If Result = "Connected" Then
Cell.Offset(0,1).Font.Color = vbGreen
Else
Cell.Offset(0,1).Font.Color = vbRed
End If
关于excel - 使用 VBA 代码 Ping IP 地址并在 Excel 中返回结果,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/21020077/