Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

VBA Ping ausführen inc. auswertung

Frage Entwicklung VB for Applications

Mitglied: Cyberkey

Cyberkey (Level 1) - Jetzt verbinden

29.03.2010, aktualisiert 12:35 Uhr, 12561 Aufrufe, 20 Kommentare

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

01.
Private Sub Ping1_Click() 
02.
Dim nTime As String 
03.
Dim strIP As String 
04.
strIP = Me.[IPall]     'IP-Adresse wird aus einer Tabelle als Variable geholt 
05.
 
06.
    
07.
                        'nTime = Ping(strIP)  'funktioniert so nicht  
08.
 
09.
    nTime = Shell("cmd.exe /K ping " & strIP & " -n 1 -w 10") 
10.
    If nTime > 0 Then 
11.
        MsgBox "Rechner erreichbar: Pingzeit: " & nTime & " ..." 
12.
      Else 
13.
        MsgBox "Rechner nicht erreichbar!" 
14.
    End If 
15.
End Sub
c3e835c35877af0a320b1f7ce6cd44b6 - Klicke auf das Bild, um es zu vergrößern


[Edit] scheint sich wohl um die TaskID zu Handeln
Vll. kann man das ja irgendwie anders machen... ?
Mitglied: 76109
29.03.2010 um 12:36 Uhr
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
Bitte warten ..
Mitglied: Cyberkey
29.03.2010 um 13:09 Uhr
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...

01.
Dim strTarget, strPingResults, objShell, objExec 
02.
On Error Resume Next 
03.
 
04.
strTarget = "XXX.XXX.XXX.XXX" 'IP address or hostname 
05.
Set objShell = CreateObject("WScript.Shell") 
06.
Set objExec = objShell.Exec("ping -n 2 -w 10 " & strTarget) 
07.
'Set ShowSystemAlarm = MsgBox 
08.
strPingResults = LCase(objExec.StdOut.ReadAll) 
09.
If Not InStr(strPingResults, "Reply from") Then MsgBox ("There is no LAN connection to the database server !") Else MsgBox ("GEHT!! !") 
10.
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?
Bitte warten ..
Mitglied: bastla
29.03.2010 um 13:18 Uhr
Hallo cyberkey!

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

Grüße
bastla
Bitte warten ..
Mitglied: Cyberkey
29.03.2010 um 13:30 Uhr
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???

01.
Dim strTarget, strPingResults, objShell, objExec 
02.
On Error Resume Next 
03.
 
04.
strTarget = "123.123.123.123" 'IP address or hostname 
05.
Set objShell = CreateObject("WScript.Shell") 
06.
Set objExec = objShell.Exec("ping -n 2 -w 10 " & strTarget) 
07.
strPingResults = LCase(objExec.StdOut.ReadAll) 
08.
 
09.
If Not InStr(strPingResults, "Antwort von") Then GoTo Nein Else GoTo JA 
10.
 
11.
JA: 
12.
MsgBox ("Geht") 
13.
GoTo beenden 
14.
 
15.
Nein: 
16.
MsgBox ("Geht nicht") 
17.
    'Me!Wake.Visible = True 
18.
     
19.
beenden: 
20.
 
21.
End Sub
Bitte warten ..
Mitglied: bastla
29.03.2010 um 13:39 Uhr
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 ):
01.
If InStr(strPingResults, "Antwort von") > 0 Then 
02.
    MsgBox ("Geht") 
03.
Else 
04.
    MsgBox ("Geht nicht") 
05.
End If
Grüße
bastla
Bitte warten ..
Mitglied: Cyberkey
29.03.2010 um 14:00 Uhr
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
Bitte warten ..
Mitglied: 76109
29.03.2010 um 14:20 Uhr
Hallo Cyberkey!

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

Bei mir sieht die Rückgabe z.B. so aus:
01.
 
02.
ping wird ausgefhrt fr xxx.xxx.xxx.xx mit 32 bytes daten: 
03.
zeitberschreitung der anforderung. 
04.
 
05.
ping-statistik fr xxx.xxx.xxx.xx: 
06.
    pakete: gesendet = 1, empfangen = 0, verloren = 1 
07.
    (100% verlust),
oder so:
01.
 
02.
Ping wird ausgeführt für  XXX.XXX.XXX.XXX mit 32 Byt 
03.
Antwort von  XXX.XXX.XXX.XXX: Bytes=32 Zeit<1ms TTL= 
04.
 
05.
Ping-Statistik für  XXX.XXX.XXX.XXX: 
06.
    Pakete: Gesendet = 1, Empfangen = 1, Verloren 
07.
    (0% Verlust), 
08.
Ca. Zeitangaben in Millisek.: 
09.
    Minimum = 0ms, Maximum = 0ms, Mittelwert = 0ms
Gruß Dieter
Bitte warten ..
Mitglied: Cyberkey
29.03.2010 um 14:38 Uhr
Noch eine Sache.. dieses CMD Fenster Nervt.. und Verwirrt... es gibt doch so einen Hide Befehl ... kann mir den jemand integrieren?

01.
If InStr(strPingResults, "Antwort von") > 0 Then  
02.
MsgBox ("Geht")  
03.
Else  
04.
    MsgBox ("Geht nicht")  
05.
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 =)
Bitte warten ..
Mitglied: 76109
29.03.2010 um 14:43 Uhr
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
Bitte warten ..
Mitglied: Cyberkey
29.03.2010 um 14:48 Uhr
Danke,
Aber wo genau schreibe ich den Code hinzu?

01.
Set objShell = CreateObject("WScript.Shell") 
02.
Set objExec = objShell.Exec("ping -n 1 -w 5 " & strTarget)
Als ich meine das ist die richtige Stelle.... aber wo da ???
Bitte warten ..
Mitglied: 76109
29.03.2010 um 14:59 Uhr
Hallo Cyberkey!

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

Ausblenden:
01.
Private Sub Ping1_Click()  
02.
    Dim .... 
03.
 
04.
    Me.Hide 
05.
    .... 
06.
    .... 
07.
    Me.Show 
08.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: Cyberkey
29.03.2010 um 15:16 Uhr
Hallo Dieter..
Schließen macht keinen Sinn da sich das CMD Fenster nach einer Sekunde selber schließt. Aber es Verwirrt eben manche Leute....
01.
intReturn = WshShell.Run("C:\Programme\IrfanView\i_view32.exe C:\Anmeldung.bmp /hide=15 ", 1, false)
glaub VBS

01.
Set objShell = CreateObject("WScript.Shell")  
02.
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..
Bitte warten ..
Mitglied: 76109
29.03.2010 um 15:32 Uhr
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
Bitte warten ..
Mitglied: bastla
29.03.2010 um 16:16 Uhr
Hallo Cyberkey!

Soferne Du kein Windows 2000 berücksichtigen musst, wäre es so wohl eher in Deinem Sinn:
01.
strTarget = "010.128.008.035" 'IP address or hostname  
02.
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") 
03.
Set colItems = objWMIService.ExecQuery("Select * from Win32_PingStatus Where Address = '" & strTarget & "'") 
04.
For Each objItem in colItems 
05.
    If objItem.StatusCode = 0 Then  
06.
        MsgBox "Geht"           
07.
    End If 
08.
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
Bitte warten ..
Mitglied: Cyberkey
29.03.2010 um 16:38 Uhr
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?

01.
strTarget = "123.123.123.123" 'IP address or hostname in 
02.
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 =(
Bitte warten ..
Mitglied: bastla
29.03.2010 um 16:43 Uhr
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
Bitte warten ..
Mitglied: Cyberkey
29.03.2010 um 16:56 Uhr
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.

01.
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]
01.
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 ..
Bitte warten ..
Mitglied: 76109
29.03.2010 um 21:01 Uhr
Hallo Cyberkey!

Versuchs mal so:

Wert als Datentyp Text:
01.
DoCmd.RunSQL "UPDATE Ip_adressen SET Online='WERT' WHERE IPall='" & strTarget & "'"
Wert als Datentyp Zahl:
01.
DoCmd.RunSQL "UPDATE Ip_adressen SET Online=WERT WHERE IPall='" & strTarget & "'"
Gruß Dieter
Bitte warten ..
Mitglied: Cyberkey
29.03.2010 um 22:25 Uhr
Danke Dieter!
Morgen werde ich das mal ausprobieren und Berichten =)
Bitte warten ..
Mitglied: Cyberkey
30.03.2010 um 09:28 Uhr
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:

01.
DoCmd.SetWarnings False 
Danke für die Hilfe =)
Bitte warten ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
VB for Applications
Powershell Script aus VBA heraus ausführen (2)

Frage von mcnico1978 zum Thema VB for Applications ...

JavaScript
AngularJS Variable über Input in Funktion ausführen

Frage von badkilla zum Thema JavaScript ...

Windows Server
gelöst Skript per GPO ausführen - Berechtigungen? (13)

Frage von honeybee zum Thema Windows Server ...

VB for Applications
Excel VBA Sortierung von Daten (5)

Frage von easy4breezy zum Thema VB for Applications ...

Heiß diskutierte Inhalte
Windows Userverwaltung
Ausgeschiedene Mitarbeiter im Unternehmen - was tun mit den AD Konten? (34)

Frage von patz223 zum Thema Windows Userverwaltung ...

LAN, WAN, Wireless
gelöst Server erkennt Client nicht wenn er ausserhalb des DHCP Pools liegt (28)

Frage von Mar-west zum Thema LAN, WAN, Wireless ...

Windows Server
Server 2008R2 startet nicht mehr (Bad Patch 0xa) (18)

Frage von Haures zum Thema Windows Server ...