dcsimg
Results 1 to 14 of 14

Thread: [RESOLVED] Error in VBA script for Pinging IP Addresses

  1. #1

    Thread Starter
    New Member
    Join Date
    Oct 2018
    Posts
    7

    Resolved [RESOLVED] Error in VBA script for Pinging IP Addresses

    Hello guys, I am facing an issue regarding to ping IP addresses and return the output in the next column. Here's the code that I found on the Internet and that I am using it:

    Code:
    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
    I replace "Sheet1" and "B3" with the name of my sheet and my IP addresses column. But when I run it appears a Run-time error '-2147217385 (80041017)': Automation error and highlights the following row:
    Code:
    For Each objStatus In objPing
    I have already verified that my WMI is "Started" in Service Status. can someone help me please? Thanks in advance!

  2. #2
    PowerPoster
    Join Date
    Dec 2004
    Posts
    23,778

    Re: Error in VBA script for Pinging IP Addresses

    i copied and pasted the exact code into excel, worked fine without error for 30 ip addresses in the range starting b3, you need to check if WMI is enabled and returning a correct result, in w 10 you may need to run the code using elevated privileges, but i did not test for that
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  3. #3

    Thread Starter
    New Member
    Join Date
    Oct 2018
    Posts
    7

    Re: Error in VBA script for Pinging IP Addresses

    Thank you for your reply westconn1. The WMI appears as "Started" in Status Service but when I go to cmd and ENTER "net start Winmgmt" it returns that a system error 5 has occurred and access is denied. Probably my company does not allow me to make an operation of this kind. Is there another way of pinging IP addresses with VBA? Thanks!

  4. #4
    PowerPoster
    Join Date
    Jun 2015
    Posts
    2,067

    Re: Error in VBA script for Pinging IP Addresses

    Disabling WMI on corporate machines is common.
    You'll have to use an API like IcmpSendEcho()

  5. #5
    PowerPoster
    Join Date
    Dec 2004
    Posts
    23,778

    Re: Error in VBA script for Pinging IP Addresses

    Is there another way of pinging IP addresses with VBA?
    there has been a thread recently to fast pinging of multiple ip addresses see if you can find it, else i can dig it up later
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  6. #6
    PowerPoster
    Join Date
    Dec 2004
    Posts
    23,778

    Re: Error in VBA script for Pinging IP Addresses

    see post #3 http://www.vbforums.com/showthread.p...yncronous+ping

    the above was not written by me, and is using a form in vb6, but would not take much to adapt to VBA worksheet
    as this uses async pings it does not need to wait for time outs etc before it pings the next address, so works much faster for multiple IPs
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  7. #7

    Thread Starter
    New Member
    Join Date
    Oct 2018
    Posts
    7

    Re: Error in VBA script for Pinging IP Addresses

    thank you DEXWERX and westconn1 for your feedback. @westconn1 I will try it as soon I'll get work and I let you know!
    Last edited by tmealha; Oct 3rd, 2018 at 03:36 AM.

  8. #8

    Thread Starter
    New Member
    Join Date
    Oct 2018
    Posts
    7

    Re: Error in VBA script for Pinging IP Addresses

    Thanks again for your help westconn1 but I am still quite new working with VBA and that code is too complex for my knowledge... I will try to study it a little bit before dig into it.

  9. #9
    PowerPoster
    Join Date
    Dec 2004
    Posts
    23,778

    Re: Error in VBA script for Pinging IP Addresses

    i spent a bit of time and converted the code from the other thread to vba,
    copy and paste the class code in other thread to a class module named ClassPingBase

    copy and paste the code below into the worksheet module
    Code:
    Option Explicit
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    Private WithEvents m_clsPingBase As ClassPingBase
    Private rng As Range
    Private m_bFirstRun As Boolean
    
    Sub asyncpingrange()
    Dim saAdresses() As String, n As Integer
    Dim tm1 As Long, tm2 As Long, mystr As String
        Set rng = Range("b3:b32")
        Set m_clsPingBase = New ClassPingBase
        ReDim saAdresses(rng.cells.Count)
        For n = 1 To rng.cells.Count
            '//Store value
    
            saAdresses(n - 1) = rng(n).Text
        Next
        tm1 = GetTickCount()
        m_clsPingBase.NumParalellActions = 1000
        m_clsPingBase.PingHostList saAdresses, 100, (rng.cells.Count * 100) / 2
    
        tm2 = GetTickCount()
        m_bFirstRun = True
        
    
        rng(rng.cells.Count + 1).Value = Format((tm2 - tm1) / 1000, "0.00") & " secs"
    End Sub
    
    Private Sub m_clsPingBase_PingSuccess(sIPAdress As String, lNewStatus As Long, ArrayIndex As Long)
      rng(ArrayIndex + 1).Offset(, 2).Value = "Connected"
    
    End Sub
    Private Sub m_clsPingBase_PingFail(sIPAdress As String, lNewStatus As Long, ArrayIndex As Long)
      rng(ArrayIndex + 1).Offset(, 2).Value = "Ping failed"
    
    End Sub
    change range to suit, call asyncpingrange from a button or whatever
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  10. #10

    Thread Starter
    New Member
    Join Date
    Oct 2018
    Posts
    7

    Re: Error in VBA script for Pinging IP Addresses

    I have done it but when I run it returns a "Compile error: Only valid in object module" and highlights the following row:
    Code:
    Private WithEvents m_clsPingBase As ClassPingBase

  11. #11
    PowerPoster
    Join Date
    Dec 2004
    Posts
    23,778

    Re: Error in VBA script for Pinging IP Addresses

    Only valid in object module
    see post #9
    copy and paste the code below into the worksheet module
    the worksheet module is an object module
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  12. #12

    Thread Starter
    New Member
    Join Date
    Oct 2018
    Posts
    7

    Re: Error in VBA script for Pinging IP Addresses

    I don't understand what I'm doing wrong. I go to "Insert"->"Class Module" and then I past the class code of the other thread (#3). Then I go to "Insert"->"Module" and I past the code that you provided on #9. Isn't it this how I should proceed? Sorry about my ignorance about this subject

  13. #13
    PowerPoster
    Join Date
    Dec 2004
    Posts
    23,778

    Re: Error in VBA script for Pinging IP Addresses

    Then I go to "Insert"->"Module"
    no, you do not need a std module, you should use a worksheet object module

    above all the modules forms etc, under Microsoft Excel Objects, you have modules for thisworkbook and each worksheeet, use the one for the worksheet that will contain the data
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

  14. #14

    Thread Starter
    New Member
    Join Date
    Oct 2018
    Posts
    7

    Re: Error in VBA script for Pinging IP Addresses

    It's working! Many thanks westconn1, I really appreciate your time and effort

Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width