使用VBA代码Ping IP地址并在Excel中返回结果 [英] Ping IP Address with VBA code and return results in Excel

问题描述

我有一些可视化的基本代码（见下文），用于测试columb B（excel spreedsheet）中的ip连接，并确定它是否在columb c中连接或不可访问，我只是想知道是否可以帮助我想要它，如果连接它会是任何其他的结果将是红色，

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

许多谢谢，
Andy

 函数GetPingResult ）
 
 Dim objPing As Object 
 Dim objStatus As Object 
 Dim Result As String 
 
设置objPing = GetObject（winmgmts：{impersonationLevel = impersonate} ）。 _ 
 ExecQuery（Select * from Win32_PingStatus Where Address ='& Host&'）
 
对于每个objStatus在objPing 
中选择Case objStatus.StatusCode 
案例0：strResult =已连接
案例11001：strResult =缓冲区太小
案例11002：strResult =目标网络不可达
案例11003：strResult =目标主机不可达
案例11004：strResult =目标协议不可达
案例11005：strResult =目标端口不可达
案例11006：strResult =无资源
案例11007： strResult =错误选项
案例11008：strResult =硬件错误
案例11009：strResult =数据包太大
案例11010：strResult =请求超时
 Case 11011：strResult =Bad request
 Case 11012：strResult =Bad route
案例11013：strResult =生存时间（TT L）过期运输
案例11014：strResult =生存时间（TTL）过期重组
案例11015：strResult =参数问题
案例11016：strResult =源$ c 
 Case 11017：strResult =Option too big
 Case 11018：strResult =Bad destination
 Case 11032：strResult =Negotiating IPSEC
 Case 11050：strResult =一般失败
案例其他：strResult =未知主机
结束选择
 GetPingResult = strResult 
下一个
 
设置objPing = Nothing 
 
结束函数
 
 Sub GetIPStatus（）
 
 Dim Cell As Range 
 Dim ipRng As Range 
 Dim Result As String 
 Dim Wks As Worksheet 
 
 
设置Wks =工作表（Sheet1）
 
设置ipRng = Wks.Range（B3）
设置RngEnd = Wks.Cells（Rows.Count，ipRng.Column）.End（xlUp）
设置ipRng = IIf（RngEnd.Row< ipRng.Row，ipRng，Wks.Range（ipRng，RngEnd））
 
每个单元格在ipRng 
结果= GetPingResult（单元格）
 Cell.Offset（0，1） = result 
下一个单元格
 
 End Sub 
  

解决方案

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

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

  = C2 =已连接
  

并格式化为绿色。如果要在代码中执行，可以在For Each循环中添加一些行

 如果Result =Connected 
 Cell.Offset（0,1）.Font.Color = vbGreen 
 Else 
 Cell.Offset（0,1）.Font.Color = vbRed 
 End If 
  

I have some visual basic code (see below) that tests an ip connection in columb B (of excel spreedsheet) and puts whether or not it is connected or un-reachable in columb c, i was just wondering if you could help me i would like it if 'connected' it would be geen any other result would be red,

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 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

解决方案

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

If Result = "Connected" Then
    Cell.Offset(0,1).Font.Color = vbGreen
Else
    Cell.Offset(0,1).Font.Color = vbRed
End If

这篇关于使用VBA代码Ping IP地址并在Excel中返回结果的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！