Bonjour
J'utilise un code VBA qui me permet de pinger une liste postes notifiés en colonne "C" et d'afficher en face colonne "D" l'adresse IP si celui ci est joignable, sinon écrit "Poste Non injoignable".
Le souci est que :
1 - Je dois indiquer dans le code VBA pour chaque feuille sur laquelle je l'applique, la première cellule de la plage à tester (la première cellule ou le test doit commencer).
2 - j'aimerai qu'il ne reteste pas les postes dont l'adresse IP est déjà indiquée en résultat mais repasse par contre sur les résultats indiquant "Poste Non joignable" ce qui est logique. Les pc dont je dispose déjà de l'IP ne sont pas à retester . Seulement les postes dont je ne possède pas l IP.
L idéal sera d'avoir une fenêtre qui demande la plage à tester bien sur. Ce que je ne sais pas faire. j'ai juste réussi à corriger une erreur car le ping commençait en haut de la feuille. Ou alors qu'il détecte la ou commence la colonne C et commence à ce niveau . Puis arrête bien sur quand il n'y a plus rien à tester (cellule en C vide)
Voici le code qui pourra en aider certains car il fonctionne malgré tout. Et donc je suis obligé de rentrer en ligne " Set Tab_Ra = Range("C18:C")" le début de la plage à tester. donc ici C18. :
Sub PingListePostes()
On Error Resume Next
Dim Tab_Ra As Range, Cel_en_Cours As Range, objhttp As Variant, PingResult As Variant, Computer$, IP As String
Set objhttp = CreateObject("MSXML2.ServerXMLHTTP.4.0")
Set Tab_Ra = Range("C18:C" & Range("C89888").End(xlUp).Row)
For Each Cel_en_Cours In Tab_Ra.Cells
If Cel_en_Cours.Offset(0, 1).Value = "" Or Cel_en_Cours.Offset(0, 1).Value = "Poste Non joignable" Then
Computer$ = Trim(Cel_en_Cours.Value): IP = ""
For Each PingResult In GetObject("winmgmts://./root/cimv2").ExecQuery _
("SELECT * FROM Win32_PingStatus WHERE Address = '" & Computer$ & "'")
If IsObject(PingResult) Then IP = PingResult.ProtocolAddress
Next
If IP = "" Then Cel_en_Cours.Offset(0, 1).Value = "Poste Non joignable" Else Cel_en_Cours.Offset(0, 1).Value = IP
End If
Next Cel_en_Cours
Set objhttp = Nothing
MsgBox "FIN DU PING"
End Sub
J'utilise un code VBA qui me permet de pinger une liste postes notifiés en colonne "C" et d'afficher en face colonne "D" l'adresse IP si celui ci est joignable, sinon écrit "Poste Non injoignable".
Le souci est que :
1 - Je dois indiquer dans le code VBA pour chaque feuille sur laquelle je l'applique, la première cellule de la plage à tester (la première cellule ou le test doit commencer).
2 - j'aimerai qu'il ne reteste pas les postes dont l'adresse IP est déjà indiquée en résultat mais repasse par contre sur les résultats indiquant "Poste Non joignable" ce qui est logique. Les pc dont je dispose déjà de l'IP ne sont pas à retester . Seulement les postes dont je ne possède pas l IP.
L idéal sera d'avoir une fenêtre qui demande la plage à tester bien sur. Ce que je ne sais pas faire. j'ai juste réussi à corriger une erreur car le ping commençait en haut de la feuille. Ou alors qu'il détecte la ou commence la colonne C et commence à ce niveau . Puis arrête bien sur quand il n'y a plus rien à tester (cellule en C vide)
Voici le code qui pourra en aider certains car il fonctionne malgré tout. Et donc je suis obligé de rentrer en ligne " Set Tab_Ra = Range("C18:C")" le début de la plage à tester. donc ici C18. :
Sub PingListePostes()
On Error Resume Next
Dim Tab_Ra As Range, Cel_en_Cours As Range, objhttp As Variant, PingResult As Variant, Computer$, IP As String
Set objhttp = CreateObject("MSXML2.ServerXMLHTTP.4.0")
Set Tab_Ra = Range("C18:C" & Range("C89888").End(xlUp).Row)
For Each Cel_en_Cours In Tab_Ra.Cells
If Cel_en_Cours.Offset(0, 1).Value = "" Or Cel_en_Cours.Offset(0, 1).Value = "Poste Non joignable" Then
Computer$ = Trim(Cel_en_Cours.Value): IP = ""
For Each PingResult In GetObject("winmgmts://./root/cimv2").ExecQuery _
("SELECT * FROM Win32_PingStatus WHERE Address = '" & Computer$ & "'")
If IsObject(PingResult) Then IP = PingResult.ProtocolAddress
Next
If IP = "" Then Cel_en_Cours.Offset(0, 1).Value = "Poste Non joignable" Else Cel_en_Cours.Offset(0, 1).Value = IP
End If
Next Cel_en_Cours
Set objhttp = Nothing
MsgBox "FIN DU PING"
End Sub