[XL-2010] Aide pour modification d'un code VBA (Fonction Ping sous Excel)

Bonjour à tous,

Je cherche a modifier (Pas grand chose) un code VBA servant à pinger des machines, étant un petit newbie en VBA je me tourne donc vers vous.

Voici le code à modifier :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
 
'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 = "Ping Ok"
         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

Ce que j'aimerai modifier se trouve au niveau des résultats du ping (Ligne 20)
Je voudrais que ça affiche l'adresse IP de la machine au lieu de "Ping Ok"

Sachant que mon fichier excel contient uniquement des hostnames c'est pour ça que j'aimerai afficher l'adresse ip quand le ping se fait correctement.

En vous remerciant,
Cordialement.