+ Reply to Thread
Results 1 to 2 of 2

MACRO to ping IP addresses and place result in adjacent cell

Hybrid View

  1. #1
    Registered User
    Join Date
    08-12-2015
    Location
    Texas
    MS-Off Ver
    Office 2013
    Posts
    2

    MACRO to ping IP addresses and place result in adjacent cell

    I originally used Leith's solution provided in the following thread:
    http://www.excelforum.com/excel-prog...next-cell.html

    Unfortunately, the macro does not do an IP address validation check before executing the "ping" and an empty IP address field incorrectly generates a 'Connected' ping result.

    Can someone modify Leith's original macro to bypass the ping check if the IP address cell is blank and write out "Invalid IP" to the adjacent field?

    Thanks in advance.

    'Written: October 28, 2009
    'Author:  Leith Ross
    'Summary: Pings either a local or remote cpmputer and returns the result as a string.
    '         This code uses the WMI to retrieve the information. It runs on Windows 2000
    '         2002, 2003, and XP.This code has not been tested on Windows Vista or later.
    '         The variable "Host" can be either a local or remote IP address an DNS name.
    
    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

  2. #2
    Forum Expert millz's Avatar
    Join Date
    08-14-2013
    Location
    Singapore
    MS-Off Ver
    Excel, Access 2016
    Posts
    1,694

    Re: MACRO to ping IP addresses and place result in adjacent cell

    I believe adding a condition like this should work:
          For Each Cell In ipRng
            If Cell.Value <> "" Then
              Result = GetPingResult(Cell)
              Cell.Offset(0, 1) = Result
            Else
              Cell.Offset(0, 1) = "Invalid IP"
            End If
          Next Cell
    多么想要告诉你 我好喜欢你

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Ping IP Address and Write Result to next Cell
    By tomlancaster in forum Excel Programming / VBA / Macros
    Replies: 8
    Last Post: 08-12-2015, 06:06 PM
  2. Replies: 5
    Last Post: 07-14-2014, 06:45 PM
  3. [SOLVED] code to recognize text in a cell and place corresponding info in adjacent cell
    By m1980rae in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 11-22-2013, 05:05 PM
  4. [SOLVED] Macro to sort and place data in adjacent columns
    By T15K in forum Excel Programming / VBA / Macros
    Replies: 8
    Last Post: 11-01-2013, 06:14 AM
  5. [SOLVED] Formula For - Find value and place value in adjacent cell here
    By CJBeaty in forum Excel Formulas & Functions
    Replies: 4
    Last Post: 01-23-2013, 09:49 PM
  6. [SOLVED] Extract Code from Cell and Place it Adjacent one.
    By Patish in forum Excel General
    Replies: 10
    Last Post: 06-23-2012, 04:43 AM
  7. Ping a host and save the result to a cell
    By johncassell in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 06-05-2007, 10:42 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1