Ping automatique de bornes Wifi

**elvorion** · 16/04/2014, 11h18

Bonjour à tous et à toutes,

Je me permets de venir vers vous car je commence à sécher sur un script en VBA (n'étant pas programmeur à l'origine), j'ai réussi à créer une partie, mais celui ci reste incomplet voila le concept que j'ai pour le moment :

J'ai un fichier Excel avec 2 boutons dessus qui font ceci :

- Un RUNPING : qui permet de lancer la commande ping "adresse ip" et qui affiche le résultat juste à coté de l'adresse IP (voir Screenshot)
- Un clear : qui permet de nettoyer les cellules d'une colonne uniquement pour effacer les résultats de la commande PING.

Nom : ping.JPG
Affichages : 1593
Taille : 109,2 Ko

Ce que je recherche à faire :

-RunPing : j'aimerais que la commande soit légèrement modifié pour qu'il exécute une commande ping -t 10 "adresse ip" et qu'il affiche comme réponse "OK" ou "Failed" si l'ip pingé ne répond pas au lieu du copié collé du résultat obtenu actuellement .
- Clear : pas besoin de toucher, il est correcte

De plus j'aimerais que ce fichier s’exécute une fois par semaine de façon automatique en exécutant automatiquement le "clear" avant d'effectuer le "runping" afin d'effacer les résultats obtenus précédemment, et qu'après chaque exécution du "runping" le fichier s'enregistre toujours automatiquement à un format du style "Tiger-ping-jour-mois-année.xlsm" exemple : Tiger-ping-16-04-2014.xslm

Quelqu'un aurait l'amabilité de m'aider dans cette manœuvre sachant que je ne suis pas très calé en VBA ?

Voici le code que j'ai pour le moment :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 
Sub ResetValues2()
    'ResetValues
    Range("b6:b11").Select
    Selection.ClearContents
    Rows("6:6").Select
End Sub
 
Sub RunPing()
 
i = 6
While (ActiveSheet.Cells(i, 1) <> "")
'Retrieve IP address
strCompAddress = ActiveSheet.Cells(i, 1)
 
'//Setup Shell command for Ping
'//NOTE: Make to leave a space after PING.exe
Dim strShellCommand As String
strShellCommand = "C:\Windows\System32\PING.exe " + strCompAddress
 
'//Create Shell Object in to run Scripts
Set oSh = CreateObject("WScript.Shell")
 
Set oEx = oSh.Exec(strShellCommand)
 
'//Read output buffer
strBuf = oEx.StdOut.ReadAll
ActiveSheet.Cells(i, 2) = strBuf
i = i + 1
Wend
End Sub

Cordialement

Invité · 16/04/2014, 12h25

ici on enregistre le résultat dans un fichier.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub test()
strShellCommand = "CMD.EXE /C ""PING 192.168.1.1""  > C:\MyTest\ping.txt"
Shell strShellCommand
 
 
End Sub

**elvorion** · 16/04/2014, 12h32

Comme je disais il faut que le résultat reste dans le même fichier, il n'est pas envisageable de faire ça sur un fichier .txt

Merci tout de même d'avoir tenté

Invité · 16/04/2014, 12h35

tu ouvre le fichier texte et tu récupère tes valeurs que tu coll dans Excel? le tout par macro!

**elvorion** · 16/04/2014, 13h19

Comme je n'ai pas beaucoup de connaissance en VBA donc pour moi c'est assez compliqué ! mais bon je prends tout ce qui peut m'aider

Invité · 16/04/2014, 13h45

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub test()
Dim Fichier As String
Dim Txt As String
Dim FileNumber As Long
Fichier = "C:\MyTest\ping.txt"
Kill Fichier
strShellCommand = "CMD.EXE /c ""PING 192.168.1.1""  > " & Fichier
Shell strShellCommand
Application.Wait Time + TimeSerial(0, 0, 5)
FileNumber = FreeFile
[A1] = ""
If Dir(Fichier) <> "" Then
    Open Fichier For Input As FileNumber   ' Ouvre le fichier en lecture.
    Do While Not EOF(FileNumber)
       Line Input #FileNumber, Txt     ' Lit la ligne
        Debug.Print Txt     ' Affiche les données dans la fenêtre Exécution.
 
             [A1] = [A1] & Txt & Chr(10) 'Colle le résulta en A1
 
 
      Loop
    Close #FileNumber   ' Ferme le fichier.
End If
End Sub

**elvorion** · 16/04/2014, 14h40

merci,

Mais du coup t'as pas du tout repris ce que j'avais fais de base ?

Parce que au final de ce que j'ai fais j'aimerais essentiellement faire :

RunPing : j'aimerais que la commande soit légèrement modifié pour qu'il exécute une commande ping -t 10 "adresse ip" et qu'il affiche comme réponse "OK" ou "Failed" si l'ip pingé ne répond pas au lieu du copié collé du résultat obtenu actuellement .

c'est possible de l'implanter dans le code que j'ai déjà commencé ?

Invité · 16/04/2014, 14h57

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub ResetValues2()
    'ResetValues
    Range("b6:b11").Select
    Selection.ClearContents
    Rows("6:6").Select
End Sub
 
Sub RunPing()
 
i = 6
While (ActiveSheet.Cells(i, 1) <> "")
'Retrieve IP address
'//Setup Shell command for Ping
'//NOTE: Make to leave a space after PING.exe
ActiveSheet.Cells(i, 2) = RetournPing(ActiveSheet.Cells(i, 1))
i = i + 1
Wend
ActiveSheet.Cells(i, 2).EntireColumn.AutoFit
MsgBox "Fin"
End Sub
 
Function RetournPing(Ip As String)
Dim Fichier As String
Dim Txt As String
Dim FileNumber As Long
Fichier = Environ("UserProfile") & "\ping.txt"
Kill Fichier
strShellCommand = "CMD.EXE /c ""PING " & Ip & """ > " & Fichier
Shell strShellCommand
Application.Wait Time + TimeSerial(0, 0, 5)
FileNumber = FreeFile
RetournPing = ""
If Dir(Fichier) <> "" Then
    Open Fichier For Input As FileNumber   ' Ouvre le fichier en lecture.
    Do While Not EOF(FileNumber)
       Line Input #FileNumber, Txt     ' Lit la ligne
        Debug.Print Txt     ' Affiche les données dans la fenêtre Exécution.
    If Trim("" & Txt) <> "" Then RetournPing = RetournPing & Txt & Chr(10)             'Colle le résulta en A1
 
 
      Loop
    Close #FileNumber   ' Ferme le fichier.
End If
End Function

en réalité il n'y avait pas grand chose a modifier dans ton code!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub ResetValues2()
    'ResetValues
    Range("b6:b11").Select
    Selection.ClearContents
    Rows("6:6").Select
End Sub
 
Sub RunPing()
 
i = 6
While (ActiveSheet.Cells(i, 1) <> "")
'Retrieve IP address
strCompAddress = ActiveSheet.Cells(i, 1)
 
'//Setup Shell command for Ping
'//NOTE: Make to leave a space after PING.exe
Dim strShellCommand As String
strShellCommand = "C:\Windows\System32\PING.exe " + strCompAddress
 
'//Create Shell Object in to run Scripts
Set oSh = CreateObject("WScript.Shell")
 
Set oEx = oSh.Exec(strShellCommand)
 
'//Read output buffer
strBuf = oEx.StdOut.ReadAll
Dim T
T = Split(strBuf, Chr(10))
If UBound(T) > 4 Then ActiveSheet.Cells(i, 2) = "Ok" Else: ActiveSheet.Cells(i, 2) = "Ko" 'il y a 4 test donc si chèque pas 4.
i = i + 1
Wend
End Sub

**elvorion** · 17/04/2014, 09h30

Bha comme je disais je suis une bille en VBA même si c'est un langage qui est la base de la prog, mon domaine c'est plus tout ce qui est HTML, CSS, SQL, PHP, quelques notions C++ mais le reste x) ...

En tout cas merci du coup de main, en tout cas si ça t’intéresse de développer un peu plus mon scripte pour ajouter notamment l’exécution automatique de celui-ci tout les X temps (j'ai trouvé un bout de code pour le faire mais j'ai pas eu le temps de me pencher dessus plus que ça).

Le but de ce code c'est vraiment de remplir un fichier automatiquement pour nous faire gagner du temps sur certaines tâches qui peuvent être automatiser comme celle-ci

d'autres idées pour compléter le code par rapport à ce que je recherche ?

Invité · 17/04/2014, 12h59

tu peux utiliser le gestionnaire de tache, jait testé le code s'exécute toute les minute. il faut jusque tu lui donne le bon chemin; ouvre le fichier RunPing.vbs avec notepade

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Const Fichier = "C:\MyTest\Nouveau Feuille Microsoft Office Excel.xlsx"

Code VBSCRIPT :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 Dim WS
 Const Fichier = "C:\MyTest\Nouveau Feuille Microsoft Office Excel.xlsx"
 Sub ResetValues2()
    'ResetValues
    WS.Range("b6:b11").ClearContents
End Sub
 
Sub RunPing()
Dim EXLS
Dim Wb
 
 
Set EXLS = CreateObject("excel.application")
EXLS.visible=true
Set Wb = EXLS.Workbooks.Open(Fichier)
Set WS = Wb.Sheets("Feuil1")
ResetValues2
I = 6
While (WS.Cells(I, 1) <> "")
'Retrieve IP address
strCompAddress = WS.Cells(I, 1)
 
'//Setup Shell command for Ping
'//NOTE: Make to leave a space after PING.exe
Dim strShellCommand 
strShellCommand = "C:\Windows\System32\PING.exe " + strCompAddress
 
'//Create Shell Object in to run Scripts
Set oSh = CreateObject("WScript.Shell")
 
Set oEx = oSh.Exec(strShellCommand)
 
'//Read output buffer
strBuf = oEx.StdOut.ReadAll
Dim T
T = Split(strBuf, Chr(10))
If UBound(T) > 4 Then WS.Cells(I, 2) = "Ok" Else: WS.Cells(I, 2) = "Ko" 'il y a 4 test donc si chèque pas 4.
I = I + 1
Wend
 
Wb.Save
Wb.Close False
EXLS.Quit
End Sub
RunPing

**elvorion** · 23/04/2014, 17h11

je pensais au gestionnaire de tâche aussi, mais sur un fichier xlms j’étais pas sûr que ce soit possible et comme je disais j'avais trouvé un code qui permet de lancer le script automatiquement tous les X temps (malheureusement je ne retrouve plus celle-ci je chercherai demain !)

Sinon je test ce que tu as fais demain, j'ai pas vraiment eu l'occasion de regarder aujourd'hui, trop de travail

En tout cas merci pour ton aide qui m'est précieuse pour le coup !

admettons, je veux 10 tests, j'ai juste à faire ca ou il faut modifier quelque chose d'autre sur la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If UBound(T) > 10 Then WS.Cells(I, 2) = "Ok" Else: WS.Cells(I, 2) = "Ko" 'il y a 4 test donc si chèque pas 4.

Invité · 23/04/2014, 17h46

Bobjour,
quand tu fats un ping dans un fenetre dos, le processus envoi 4 requêtes avec le nombre de trames envoyer le nombre reçu et le temps écoulé.
J' ai fait des testes si c'est ok il y a au mois 4 ligne si c'est Ko il y en a moins.
J'utilise le nombre de lignes pour dire ok ou ko je ne regarde pas le contenu.
Excuse les faute d'hortographe petit clavier petit ecran petit oeux gros doit tel portable

**elvorion** · 24/04/2014, 09h04

Justement j'aimerai faire un sorte qu'il face une 10ène de requêtes, pas parce que il m'en 10 forcement, c'est juste que certaines bornes n'arrivent pas à être pingué si la commande n'est pas en "ping -t 10.xx.xx.xx"

au passage j'ai testé le vbs que tu as mis et j'obtiens le message d'erreur suivant :/ :

Nom : Capture.JPG
Affichages : 1373
Taille : 22,0 Ko

édit : en faite c'est bon pour le message d'erreur fallait juste ré enregistrer le fichier mais en sélectionnant l'encodage "ANSI"
édit 2 : Après quelques test ça fonctionne, il complète bien le tableau etc, je maintiens donc juste le détail sur le "ping -t 10.xx.xx.xx", au passage comment pourrais-je envoyé se fichier par mail aussi une fois par semaine de façon automatique (genre juste après qu'il est enregistré le fichier) ?

Invité · 24/04/2014, 09h47

d'abord dans le fichier VBS il faut modifier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Const Fichier = "C:\MyTest\Nouveau Feuille Microsoft Office Excel.xlsx"

par le nom et l'emplacement de ton fichier.
ton erreur dit le caractère 1 de la ligne 1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim WS

u espace dans mon exemple ? chez moi ça fonctionne mais on ne sait jamais surprime l'espace.
en ce qui concerne le test on peut le répéter plusieurs foies si Ko mais qu'il fonctionne en l'état et après on modifiera.
en ce qui concerne le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If UBound(T) > 10 Then WS.Cells(I, 2) = "Ok" Else: WS.Cells(I, 2) = "Ko" 'il y a 4 test donc si chèque pas 4.

Code Ping Ok :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Envoi d'une requˆte 'Ping'  192.168.1.1 avec 32 octets de donn‚esÿ:
R‚ponse de 192.168.1.1ÿ: octets=32 temps<1ms TTL=63
R‚ponse de 192.168.1.1ÿ: octets=32 temps<1ms TTL=63
R‚ponse de 192.168.1.1ÿ: octets=32 temps<1ms TTL=63
R‚ponse de 192.168.1.1ÿ: octets=32 temps<1ms TTL=63
 
Statistiques Ping pour 192.168.1.1:
    Paquetsÿ: envoy‚s = 4, re‡us = 4, perdus = 0 (perte 0%),
Dur‚e approximative des boucles en millisecondes :
    Minimum = 0ms, Maximum = 0ms, Moyenne = 0ms

Code Ping Ko :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Envoi d'une requˆte 'Ping'  168.192.1.1 avec 32 octets de donn‚esÿ:
D‚lai d'attente de la demande d‚pass‚.
D‚lai d'attente de la demande d‚pass‚.
D‚lai d'attente de la demande d‚pass‚.
D‚lai d'attente de la demande d‚pass‚.
 
Statistiques Ping pour 168.192.1.1:
    Paquetsÿ: envoy‚s = 4, re‡us = 0, perdus = 4 (perte 100%),

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
strBuf = oEx.StdOut.ReadAll
Dim T
T = Split(strBuf, Chr(10)) 'on découpe le texte dans un tableau chr(10) est le caractère de retour à la ligne et on découpe en fonction du retour ligne

si tu regarde le 2 test Ok & KO tu vois que le nombre de ligne est différent c'est ça qui me dis si OK ou KO
effectivement >10 est judicieux un peut d'empressement!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If UBound(T) > 10 Then WS.Cells(I, 2) = "Ok" Else: WS.Cells(I, 2) = "Ko" 'il y a 4 test donc si chèque pas 4.

**elvorion** · 24/04/2014, 10h02

Tout ca c'est ok je sais pas si tu as pu lire mon edit mais je te le remets ici du coup :

édit : en faite c'est bon pour le message d'erreur fallait juste ré enregistrer le fichier mais en sélectionnant l'encodage "ANSI"
édit 2 : Après quelques test ça fonctionne, il complète bien le tableau etc, je maintiens donc juste le détail sur le "ping -t 10.xx.xx.xx", au passage comment pourrais-je envoyé se fichier par mail aussi une fois par semaine de façon automatique (genre juste après qu'il est enregistré le fichier) ?

Invité · 24/04/2014, 10h15

puisque tu commence a métisser le vbscript

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
dim Serveur
dim Identify
dim User
dim PassWord
dim Port
dim Delay
dim Expediteur
dim Dest
dim DestEnCopy
dim Objet
dim  Body
dim Pj
Serveur="smpt.free.fr"
Identify=true
User="MyUser"
PassWord="MyPassWord"
Port="993" '25 ou autre?
Delay=10
Expediteur="Moi@free.fr"
Dest="Toi@free.fr;Unautre@orenge.fr"
DestEnCopy="bof@gmail.com2of@gmail.com"
Objet="Je t'envois"
Body="bla bla bla..."
Pj="c:\monfichier1.xls;c:\monfichier2.xls"
MailEnvoi Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj
 
Public Sub MailEnvoi(Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
' sub pour envoyer les mails
Dim msg
Dim Conf
Dim Config
Dim ess
Dim splitPj
Dim IsplitPj
Set msg = CreateObject("CDO.Message") 'pour la configuration du message
Set Conf = CreateObject("CDO.Configuration") '  pour la configuration de l'envoi
Dim strHTML
 
Set Config = Conf.Fields
 
' Configuration des parametres d'envoi
'(SMTP - Identification - SSL - Password - Nom Utilisateur - Adresse messagerie)
With Config
If Identify = true Then
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = User
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PassWord
end if
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Port
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Serveur
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = Delay
    .Update
 
End With
 
 
'Configuration du message
'If E_mail.Sign.Value = Checked Then Convert ServeurFrm.SignTXT, ServeurFrm.Text1
 
With msg
    Set .Configuration = Conf
    .To = Dest
  .cc = DestEnCopy
    .FROM = Expediteur
    .Subject = Objet
'
 
    .HTMLBody = Body '"<p align=""center""><font face=""Verdana"" size=""1"" color=""#9224FF""><b><br><font face=""Comic Sans MS"" size=""5"" color=""#FF0000""></b><i>" & body & "</i></font> " 'E_mail.ZThtml.Text
            If Pj <> "" Then
        splitPj = Split(Pj & ";", ";")
 
        For IsplitPj = 0 To UBound(splitPj)
            If Trim("" & splitPj(IsplitPj)) <> "" Then
                .AddAttachment Trim("" & splitPj(IsplitPj))
            End If
        Next
 
    End If
    .Send 'envoi du message
 
End With
' reinitialisation des variables
Set msg = Nothing
Set Conf = Nothing
Set Config = Nothing
 
End Sub

toujours le planificateur de tache 1 foie par mois!

**elvorion** · 24/04/2014, 10h27

Huhu je vbscript pour le peu de cours que j'ai eu dessus, le prof était tellement pas intéressant et qu'il nous a même pas appris les bases, bha du coup on s'est perdu.

En tout cas merci une fois encore pour le coup de main je vais essayer ca :3

Invité · 24/04/2014, 10h39

je t'invite à télécharger VbsFactoty c'est un IDE gratuit!

**elvorion** · 24/04/2014, 12h22

Je vais le garder de côté pour le jour où on me demandera de faire autre chose en VBS ^^ merci du coup du main en tout cas

Ping automatique de bornes Wifi [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager