+ Reply to Thread
Results 1 to 7 of 7

Using "GetObject" and "winmgmts" to ping devices.

Hybrid View

  1. #1
    Forum Contributor Rhudi's Avatar
    Join Date
    03-08-2013
    Location
    South Carolina, US
    MS-Off Ver
    Professional Plus 2016 aka Office 365
    Posts
    201

    Using "GetObject" and "winmgmts" to ping devices.

    I found the following bit of code online yesterday. This is awesome in it's speed. I have been using an entirely different method to ping devices from within Excel. This code is much faster.

    However, I do have a question about it. I don't understand its syntax. How would I add the parameter to shorten the time out? Currently, it is about 2 seconds. In my case, I'd be happy shortening that to 1/2 second ( 500ms ).
    Function GetPingResult$(Host$)
    Dim objPing As Object
    Dim objStatus As Object
    'Dim Result$
       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: GetPingResult = "Up"
             Case 11001: GetPingResult = "Buffer too small"
             Case 11002: GetPingResult = "Destination net unreachable"
             Case 11003: GetPingResult = "Destination host unreachable"
             Case 11004: GetPingResult = "Destination protocol unreachable"
             Case 11005: GetPingResult = "Destination port unreachable"
             Case 11006: GetPingResult = "No resources"
             Case 11007: GetPingResult = "Bad option"
             Case 11008: GetPingResult = "Hardware error"
             Case 11009: GetPingResult = "Packet too big"
             Case 11010: GetPingResult = "Request timed out"
             Case 11011: GetPingResult = "Bad request"
             Case 11012: GetPingResult = "Bad route"
             Case 11013: GetPingResult = "Time-To-Live (TTL) expired transit"
             Case 11014: GetPingResult = "Time-To-Live (TTL) expired reassembly"
             Case 11015: GetPingResult = "Parameter problem"
             Case 11016: GetPingResult = "Source quench"
             Case 11017: GetPingResult = "Option too big"
             Case 11018: GetPingResult = "Bad destination"
             Case 11032: GetPingResult = "Negotiating IPSEC"
             Case 11050: GetPingResult = "General failure"
             Case Else: GetPingResult = "Unknown host"
          End Select
    '      GetPingResult = strResult
       Next
       Set objPing = Nothing
    End Function

  2. #2
    Forum Expert JapanDave's Avatar
    Join Date
    06-10-2008
    Location
    The grid, I got in!
    MS-Off Ver
    Excel 2010/13
    Posts
    1,696

    Re: Using "GetObject" and "winmgmts" to ping devices.

    Your time out is in another piece of code.
    Be fore warned, I regularly post drunk. So don't take offence (too much) to what I say.
    I am the real 'Napster'
    The Grid. A digital frontier. I tried to picture clusters of information as they moved through the computer. What did they look like? Ships? motorcycles? Were the circuits like freeways? I kept dreaming of a world I thought I'd never see. And then, one day...

    If you receive help please give thanks. Click the * in the bottom left hand corner.

    snb's VBA Help Files

  3. #3
    Forum Contributor Rhudi's Avatar
    Join Date
    03-08-2013
    Location
    South Carolina, US
    MS-Off Ver
    Professional Plus 2016 aka Office 365
    Posts
    201

    Re: Using "GetObject" and "winmgmts" to ping devices.

    Ok... So you made me look...

    And, this I found:
       Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
           ExecQuery("Select * from Win32_PingStatus Where Timeout = " & timeout & " AND Address = '" & Host & "'")

  4. #4
    Forum Expert JapanDave's Avatar
    Join Date
    06-10-2008
    Location
    The grid, I got in!
    MS-Off Ver
    Excel 2010/13
    Posts
    1,696

    Re: Using "GetObject" and "winmgmts" to ping devices.

    What is this variables value.

    timeout

  5. #5
    Forum Contributor Rhudi's Avatar
    Join Date
    03-08-2013
    Location
    South Carolina, US
    MS-Off Ver
    Professional Plus 2016 aka Office 365
    Posts
    201

    Re: Using "GetObject" and "winmgmts" to ping devices.

    Ok, let me post the entire function... :P
    Function GetPingResult$(Host$)
    Dim objPing As Object
    Dim objStatus As Object
    Const timeout$ = "350" ' Timeout Value in ms
       Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
           ExecQuery("Select * from Win32_PingStatus Where Timeout = " & timeout & " AND Address = '" & Host & "'")
    '
       For Each objStatus In objPing
          Select Case objStatus.StatusCode
             Case 0: GetPingResult = "Up"
             Case 11001: GetPingResult = "Buffer too small"
             Case 11002: GetPingResult = "Destination net unreachable"
             Case 11003: GetPingResult = "Destination host unreachable"
             Case 11004: GetPingResult = "Destination protocol unreachable"
             Case 11005: GetPingResult = "Destination port unreachable"
             Case 11006: GetPingResult = "No resources"
             Case 11007: GetPingResult = "Bad option"
             Case 11008: GetPingResult = "Hardware error"
             Case 11009: GetPingResult = "Packet too big"
             Case 11010: GetPingResult = "Request timed out"
             Case 11011: GetPingResult = "Bad request"
             Case 11012: GetPingResult = "Bad route"
             Case 11013: GetPingResult = "Time-To-Live (TTL) expired transit"
             Case 11014: GetPingResult = "Time-To-Live (TTL) expired reassembly"
             Case 11015: GetPingResult = "Parameter problem"
             Case 11016: GetPingResult = "Source quench"
             Case 11017: GetPingResult = "Option too big"
             Case 11018: GetPingResult = "Bad destination"
             Case 11032: GetPingResult = "Negotiating IPSEC"
             Case 11050: GetPingResult = "General failure"
             Case Else: GetPingResult = "Unknown host"
          End Select
       Next
       Set objPing = Nothing
    End Function

    Here is how this is called (just to play with it):
    Sub GetIPStatus()
        MsgBox "8.8.8.8 : " & GetPingResult("8.8.8.8")
        MsgBox "8.8.8.88 : " & GetPingResult("8.8.8.88")
        MsgBox "badFQDN.nuts : " & GetPingResult("badFQDN.nuts")
        MsgBox "www.google.com : " & GetPingResult("www.google.com")
    End Sub
    Last edited by Rhudi; 01-13-2016 at 01:48 PM. Reason: Add detail...

  6. #6
    Forum Expert JapanDave's Avatar
    Join Date
    06-10-2008
    Location
    The grid, I got in!
    MS-Off Ver
    Excel 2010/13
    Posts
    1,696

    Re: Using "GetObject" and "winmgmts" to ping devices.

    Change this line.

    Const timeout$ = "500" ' Timeout Value in ms
    And BTW, if you had post the full code in the first place, it would have been solved a lot quicker.
    Last edited by JapanDave; 01-14-2016 at 07:39 PM.

  7. #7
    Forum Contributor Rhudi's Avatar
    Join Date
    03-08-2013
    Location
    South Carolina, US
    MS-Off Ver
    Professional Plus 2016 aka Office 365
    Posts
    201

    Re: Using "GetObject" and "winmgmts" to ping devices.

    I'm tweaking the timout value to speed things up. I'd lowered it to 350.

+ 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. [SOLVED] Excel 2010 -- "Visual Basic" "Macros" and "Record Macro" all disabled.
    By NicholasL in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 05-07-2017, 06:11 AM
  2. Replies: 1
    Last Post: 08-15-2014, 06:00 AM
  3. Replies: 4
    Last Post: 11-17-2013, 12:05 PM
  4. [SOLVED] How to USE """"" cells count """"" change font color
    By austin123456 in forum Excel Programming / VBA / Macros
    Replies: 7
    Last Post: 10-09-2013, 06:14 AM
  5. Replies: 5
    Last Post: 10-12-2010, 06:46 AM
  6. Replies: 5
    Last Post: 06-26-2006, 09:23 PM
  7. Replies: 7
    Last Post: 05-13-2006, 05:02 PM

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