29.03.2010, aktualisiert um 12:35:08 Uhr

27106

VBA Ping ausführen inc. auswertung

Kleines VBA Script

Hallo,
Versuche einen Ping durchzuführen... die IP wird aus einer Liste geholt... (übergabe Funktioniert auch) der Ping wird ausgeführt aber ich erhalte 4 Stellige werte... die keinen Sinn ergeben. Obwohl der Ping korekt ausgeführt wird mit cmd /K kann ich ja live mitgucken.....

Ich vermute das hat was mit dem Datentyp zu tun... aber ich bin Anfänger auf dem Gebiet...

Vll. kann mir jemand helfen... schonmal danke

Private Sub Ping1_Click()
Dim nTime As String
Dim strIP As String
strIP = Me.[IPall]     'IP-Adresse wird aus einer Tabelle als Variable geholt  

   
                        'nTime = Ping(strIP)  'funktioniert so nicht   

    nTime = Shell("cmd.exe /K ping " & strIP & " -n 1 -w 10")  
    If nTime > 0 Then
        MsgBox "Rechner erreichbar: Pingzeit: " & nTime & " ..."  
      Else
        MsgBox "Rechner nicht erreichbar!"  
    End If
End Sub

[Edit] scheint sich wohl um die TaskID zu Handeln
Vll. kann man das ja irgendwie anders machen... ?

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 139389

Url: https://administrator.de/contentid/139389

Ausgedruckt am: 26.11.2024 um 14:11 Uhr

20 Kommentare

Neuester Kommentar

Hallo Cyberkey!

Der Rückgabewert (Double) enthält nur die Task-ID des Programms. Eventuell ist es sinnvoll, die Ausgabe per Pipe in eine Datei umzuleiten und dann über VBA auszulesen.

Gruß Dieter

Hallo Dieter,
das habe ich mir auch schon überlegt blos es ist eine unschöne Lösung. Da dieses Script mit sehr vielen IP's hintereinander durchgeführt werden soll. Müssten X dateien erzeugt werden und das ganze wird arg langsam...

Dim strTarget, strPingResults, objShell, objExec
On Error Resume Next

strTarget = "XXX.XXX.XXX.XXX" 'IP address or hostname  
Set objShell = CreateObject("WScript.Shell")  
Set objExec = objShell.Exec("ping -n 2 -w 10 " & strTarget)  
'Set ShowSystemAlarm = MsgBox  
strPingResults = LCase(objExec.StdOut.ReadAll)
If Not InStr(strPingResults, "Reply from") Then MsgBox ("There is no LAN connection to the database server !") Else MsgBox ("GEHT!! !")  
End Sub

Das währe auch eine Alternative Aber... bekomme immer nur die "Then" ausgabe... egal ob der Ping erfolgreich war... "Replay from" ist warschl. falsch und da sollte "Antwort von" stehen.

Sieht da jemand einen Fehler?

Hallo cyberkey!

Wenn Du (lt Deinem Screenshot) ein deutschsprachiges System verwendest, könnte es tatsächlich am "Reply from" liegen ...

Grüße
bastla

Hallo Bastla,
habe ich auch gedacht, aber es muss irgendwo noch einen anderen Fehler geben.
Aber obwohl ich den Code jetzt nochmal verändert habe bekomme ich immer die Antwort "geht nicht"
Es erscheint ja kurzzeitig so ein CMD Fenster... Das da nix drinsteht ist Normal denk ich mal da der inhalt ja woanders ausgegeben wird..

ist irgendetwas an dem code fehlerhaft???

Dim strTarget, strPingResults, objShell, objExec
On Error Resume Next

strTarget = "123.123.123.123" 'IP address or hostname  
Set objShell = CreateObject("WScript.Shell")  
Set objExec = objShell.Exec("ping -n 2 -w 10 " & strTarget)  
strPingResults = LCase(objExec.StdOut.ReadAll)

If Not InStr(strPingResults, "Antwort von") Then GoTo Nein Else GoTo JA  

JA:
MsgBox ("Geht")  
GoTo beenden

Nein:
MsgBox ("Geht nicht")  
    'Me!Wake.Visible = True  
    
beenden:

End Sub

Hallo Cyberkey!

Liegt vermutlich auch an der Schreibweise der IP-Adresse (dazu gab es vor ein paar Tagen einen Thread hier) - Kurzfassung: Lass die führenden Nullen weg ...

Das "GoTo" solltest Du Dir besser abgewöhnen (es sei denn, Du schreibst Batch

If InStr(strPingResults, "Antwort von") > 0 Then  
    MsgBox ("Geht")  
Else
    MsgBox ("Geht nicht")  
End If

Grüße
bastla

Danke für die Mühe... es Funktioniert soweit auch mit den Nullen =)

PS: Die Nullen mussten sein um das so besser zu Ordnen innerhalb einer Tabelle

Hallo Cyberkey!

Der Fehler liegt am Instr. Einfach mal eine "strPingResults" per MsgBox ausgeben.

Bei mir sieht die Rückgabe z.B. so aus:

ping wird ausgefhrt fr xxx.xxx.xxx.xx mit 32 bytes daten:
zeitberschreitung der anforderung.

ping-statistik fr xxx.xxx.xxx.xx:
    pakete: gesendet = 1, empfangen = 0, verloren = 1
    (100% verlust),

oder so:

Ping wird ausgeführt für  XXX.XXX.XXX.XXX mit 32 Byt
Antwort von  XXX.XXX.XXX.XXX: Bytes=32 Zeit<1ms TTL=

Ping-Statistik für  XXX.XXX.XXX.XXX:
    Pakete: Gesendet = 1, Empfangen = 1, Verloren
    (0% Verlust),
Ca. Zeitangaben in Millisek.:
    Minimum = 0ms, Maximum = 0ms, Mittelwert = 0ms

Gruß Dieter

Noch eine Sache.. dieses CMD Fenster Nervt.. und Verwirrt... es gibt doch so einen Hide Befehl ... kann mir den jemand integrieren?

If InStr(strPingResults, "Antwort von") > 0 Then   
MsgBox ("Geht")   
Else 
    MsgBox ("Geht nicht")   
End If

Geht ja als Alternative .. da es ja nur relevant ist ob eine Antwort kam oder nicht. Der Ping ist ja nur die bedingung dafür =)

Hallo Cyberkey!

Zitat von @Cyberkey:
Noch eine Sache.. dieses CMD Fenster Nervt.. und Verwirrt... es gibt doch so einen Hide Befehl ... kann mir den jemand
integrieren?

Me.Hide = nur versteckt und kann mit Me.Show wieder angezeigt werden. Zum Schließen "Unload Me" verwenden.

Gruß Dieter

Danke,
Aber wo genau schreibe ich den Code hinzu?

Set objShell = CreateObject("WScript.Shell")  
Set objExec = objShell.Exec("ping -n 1 -w 5 " & strTarget)  

Als ich meine das ist die richtige Stelle.... aber wo da ???

Hallo Cyberkey!

Ich weiß jetzt leider nicht, ob Du das Fenster schließen oder nur ausblenden willst.

Ausblenden:

Private Sub Ping1_Click() 
    Dim ....

    Me.Hide
    ....
    ....
    Me.Show
End Sub

Gruß Dieter

Hallo Dieter..
Schließen macht keinen Sinn da sich das CMD Fenster nach einer Sekunde selber schließt. Aber es Verwirrt eben manche Leute....

intReturn = WshShell.Run("C:\Programme\IrfanView\i_view32.exe C:\Anmeldung.bmp /hide=15 ", 1, false)  

glaub VBS

Set objShell = CreateObject("WScript.Shell")   
Set objExec = objShell.Exec("ping -n 1 -w 5 " & strTarget)  

VBA

WScript.Shell
WshShell.Run ?????

Set WshShell = WScript.CreateObject("WScript.Shell")
intReturn = WshShell.Run("C:\Programme\IrfanView\i_view32.exe C:\Anmeldung.bmp /hide=15 ", 1, false)

Da ist ja ein Hide Befehl drin... kann man das so übernehmen?

Hab ja Exec statt RUn.. hm..

Hallo Cyberkey!

Ups Sorry, ich habe etwas geschlafen

Du meintest das CMD-Fenster und ich war irgendwie auf das Formular fixiert.

Ob und wie Du das CMD-Fenster steuern kannst, bin ich leider überfragt.

Gruß Dieter

Hallo Cyberkey!

Soferne Du kein Windows 2000 berücksichtigen musst, wäre es so wohl eher in Deinem Sinn:

strTarget = "010.128.008.035" 'IP address or hostname   
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")  
Set colItems = objWMIService.ExecQuery("Select * from Win32_PingStatus Where Address = '" & strTarget & "'")  
For Each objItem in colItems
    If objItem.StatusCode = 0 Then 
        MsgBox "Geht"            
    End If
Next

Hinsichtlich ".Run" bzw ".Exec": Kein Vorteil ohne Nachteil: Mit ".Run" kannst Du zwar das CMD-Fenster verstecken, aber nicht (wie es ".Exec" erlaubt) unmittelbar die Ausgabe auslesen - daher müsstest Du dann doch die Variante über eine "Temp-Datei" nehmen ...

Grüße
bastla

Hallo Bastla... danke..

Das Stimmt.. leider etwas nachteilig. Muss ich mir noch überlegen für was ich mich entscheide..

PS: Kann mir noch jemand sagen warum dieser Code nicht Funktioniert?

strTarget = "123.123.123.123" 'IP address or hostname in  
DoCmd.RunSQL "UPDATE Ip_adressen SET Online = WERT ' WHERE KritFeld= " & strTarget & "  

Ip_adressen ist die Tabelle
123.123.123.123 ist eine IP aus Der Tabelle
Online eine Spalte
Wert... der wert der eben geschrieben werden soll.

Das Kriterium will irgendwie nicht so wie ich... es wird kein Wert geschrieben... lasse ich das Kriterium will er in jede zeile den gleichen Wert schreien =(

Hallo Cyberkey!

Könnte ich mir eher so vorstellen:

DoCmd.RunSQL "UPDATE Ip_adressen SET Online = WERT WHERE KritFeld= '" & strTarget & "'"

[Edit] Das waren wohl ein wenig zu viele Anführungszeichen am Ende - ist jetzt korrigiert [/Edit]

Grüße
bastla

Hallo Bastla
Leider wird immernoch kein Wert eingetragen... mit nem MSGBOX check zeigt er mir auch die richtige IP.. Wenn ich das ganze Mal in einer Abfrage Manuell eingebe geht auch alles. irgendwie ist da der Wurm drin. und ich vermute es betrifft das §Kriterium selbst§
Das er Quasi alles wegfiltert und er dann natürlich nichts eintragen kann. Weil wenn ich das Kriterium weglasse kommt ne frage ob ich XXXXX einträge wirklich tätigen möchte.

DoCmd.RunSQL "UPDATE Ip_adressen SET Online = Wert"

Soweit gehts... aber das würde keinen Sinn machen.

Für Anregungen bin ich sehr dankbar =)

[EDIT]

DoCmd.RunSQL "UPDATE Ip_adressen SET Online = 'Wert'"

Funktioniert jetzt. Die ' haben gefehlt. Aber jetzt soll das noch mit Kriterium laufen ...

[EDIT]
Ich habe die Vermutung das der Code soweit stimmt aber bei Kriterium noch was fehlt .... wo steht den bei wlechem Feld er das Kriterium anwenden soll???
Das fehlt mir irgendwie... Die Fehleranalyse mit MSGbox ergab keine Fehler außer das was mir eben aufgefallen ist.

[EDIT]
SELECT Ip_adressen.IPall, Ip_adressen.Online
FROM Ip_adressen
WHERE (((Ip_adressen.IPall)="Xxx.xxx.xxx.xxx"));

das wird vll der Fehler sein

aber es haut immernoch nicht hin,,,,,, nichtmal ne fehlermeldung.. werden einfach keine Datensätze geschrieben ..

Hallo Cyberkey!

Versuchs mal so:

Wert als Datentyp Text:

DoCmd.RunSQL "UPDATE Ip_adressen SET Online='WERT' WHERE IPall='" & strTarget & "'"  

Wert als Datentyp Zahl:

DoCmd.RunSQL "UPDATE Ip_adressen SET Online=WERT WHERE IPall='" & strTarget & "'"  

Gruß Dieter

Danke Dieter!
Morgen werde ich das mal ausprobieren und Berichten =)

Also... es gab irgendwie einen internen Fehler.. wollte heute wie gewohnt weiter arbeiten, aber alle änderungen waren weg.

Aber das ist nicht so schlimm weiß ja jetzt wie es geht ;)

Der letzte Stand @ Dieter ... das funktioniert Heute ohne Probleme einzig die Abfrage: "Wollen sie wirklich 1 Zeile Aktualisieren stört... Kann man das abstellen /umgehen?

Problem gelöst: