使用VBA代码Ping IP地址并在Excel中返回结果

我有一些可视化的基本代码（见下文）在columb B（excel spreedsheet）中testing一个ip连接，并通过columb c来判断它是否连接或者不可达，我只是想知道你是否可以帮助我，喜欢它，如果“连接”，这将是任何其他结果将是红色的，

这个脚本也可以每小时或每天自动运行吗？

非常感谢，安迪

Function GetPingResult(Host) Dim objPing As Object Dim objStatus As Object Dim Result 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 

Answer 1

你不需要代码。 将所有的单元格变成红色，然后添加条件格式，以便在需要时使其变为绿色。

主页>条件格式>新规则>使用公式…

 =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 

Answer 2

要在特定时间间隔自动运行，请查看此链接。

以下是相关的代码：

 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 

我会build议包括一个ThisWorkbook.Save行，因为我不能说这将运行多久，而不会崩溃，我想你可以看到问题，如果你一次离开它几天。