cyberkey
Mar 29, 2010, updated at 10:35:08 (UTC)
view26105
view20
0
Goto Top

VBA Ping ausführen inc. auswertung

GermansolvedQuestionVB for ApplicationsDevelopment

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

c3e835c35877af0a320b1f7ce6cd44b6


[Edit] scheint sich wohl um die TaskID zu Handeln
Vll. kann man das ja irgendwie anders machen... ?
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 139389

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

Printed on: April 24, 2024 at 15:04 o'clock

20 Comments
Latest comment
Goto Top
Mitglied: 76109
76109 Mar 29, 2010 at 10:36:42 (UTC)
Goto Top
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
Member: Cyberkey
Cyberkey Mar 29, 2010 at 11:09:47 (UTC)
Goto Top
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?
Member: bastla
bastla Mar 29, 2010 at 11:18:16 (UTC)
Goto Top
Hallo cyberkey!

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

Grüße
bastla
Member: Cyberkey
Cyberkey Mar 29, 2010 at 11:30:11 (UTC)
Goto Top
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
Member: bastla
bastla Mar 29, 2010 at 11:39:28 (UTC)
Goto Top
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 face-wink):
If InStr(strPingResults, "Antwort von") > 0 Then  
    MsgBox ("Geht")  
Else
    MsgBox ("Geht nicht")  
End If
Grüße
bastla
Member: Cyberkey
Cyberkey Mar 29, 2010 at 12:00:23 (UTC)
Goto Top
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
Mitglied: 76109
76109 Mar 29, 2010 at 12:20:56 (UTC)
Goto Top
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
Member: Cyberkey
Cyberkey Mar 29, 2010 at 12:38:16 (UTC)
Goto Top
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 =)
Mitglied: 76109
76109 Mar 29, 2010 at 12:43:57 (UTC)
Goto Top
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
Member: Cyberkey
Cyberkey Mar 29, 2010 at 12:48:11 (UTC)
Goto Top
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 ???
Mitglied: 76109
76109 Mar 29, 2010 at 12:59:34 (UTC)
Goto Top
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
Member: Cyberkey
Cyberkey Mar 29, 2010 at 13:16:56 (UTC)
Goto Top
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..
Mitglied: 76109
76109 Mar 29, 2010 at 13:32:08 (UTC)
Goto Top
Hallo Cyberkey!

Ups Sorry, ich habe etwas geschlafenface-wink 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
Member: bastla
bastla Mar 29, 2010 at 14:16:29 (UTC)
Goto Top
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
Member: Cyberkey
Cyberkey Mar 29, 2010 at 14:38:49 (UTC)
Goto Top
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 =(
Member: bastla
bastla Mar 29, 2010 at 14:43:59 (UTC)
Goto Top
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
Member: Cyberkey
Cyberkey Mar 29, 2010 at 14:56:12 (UTC)
Goto Top
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 ..
Mitglied: 76109
76109 Mar 29, 2010 at 19:01:11 (UTC)
Goto Top
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
Member: Cyberkey
Cyberkey Mar 29, 2010 at 20:25:14 (UTC)
Goto Top
Danke Dieter!
Morgen werde ich das mal ausprobieren und Berichten =)
Member: Cyberkey
Cyberkey Mar 30, 2010 at 07:28:09 (UTC)
Goto Top
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:

DoCmd.SetWarnings False

Danke für die Hilfe =)
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 Comments