Vba-Code, um Rechner von Datenbank aus anzupingen

Hallo Forum,

Ich habe ein Formular in dem mehrere PCs eingetragen sind (Microsoft Acces 2003). Nun bräuchte ich einen Code, der dafür sorgt, dass der in der Maske ausgewählte PC über einen zu drückenden Button angepingt wird und mir das Ergebnis mittels einer Messagebox ausgeworfen wird. Also so, dass entweder die Meldung „Nicht erreichbar“ oder „Erreichbar“ ausgegeben wird. Wichtig ist dabei, dass dies nicht über die IP geschehen sollte, sondern über den Hostnamen.

Ich habe hier schon einen kleinen Ansatz, jedoch ist der fehlerhaft, da mir die Messagebox immer die Meldung „Rechner ist erreichbar“ ausgibt, obwohl einige PCs ausgeschaltet sind und es in der cmd.exe genauso angezeigt wird.

Private Sub Ping1\_Click()   
Dim nTime As String   
Dim strComputer As String   
strComputer = Hostname 'Hostname wird aus einer Tabelle als Variable geholt   
  
  
 'nTime = Ping(strComputer) 'funktioniert so nicht   
  
 nTime = Shell("cmd.exe /K ping " & strComputer & " -n 1 -w 10")   
 If nTime \> 0 Then   
 MsgBox "Rechner erreichbar: Pingzeit: " & nTime & " ..."   
 Else   
 MsgBox "Rechner nicht erreichbar!"   
 End If   
End Sub  

Wenn Ihr Lösungs- bzw. Verbesserungsvorschläge habt, nehme ich diese gerne entgegen. (Oder wenn ihr einen ganz anderen Code habt, lasst es mich gerne wissen :smile:
Danke schonmal im Vorraus!

Hallo,

nimm halt API…

Private Declare Function IsDestinationReachable Lib „Sensapi.dll“ Alias „IsDestinationReachableA“ (ByVal lpszDestination As String, lpQOCInfo As QOCINFO) As Long

Private Type QOCINFO
dwSize As Long
dwFlags As Long
dwInSpeed As Long
dwOutSpeed As Long
End Type

Public Function fktPing(ByVal strHost As String) As Double
Dim QI As QOCINFO
Dim dblTime As Double

QI.dwSize = Len(QI)
dblTime = Timer
If IsDestinationReachable(strHost, QI) = 1 Then
fktPing = Timer - dblTime
Else
fktPing = -1
End If
End Function

Private Sub Ping1_Click()
Dim dblTime As Double
Dim strComputer As String
strComputer = Dlookup(„Hostname“,…)

dblTime = fktPing(strComputer)
If dblTime -1 Then
MsgBox „Server erreichbar. Reaktionszeit: " & dblTime & " Sek.“
Else
MsgBox „Server nicht erreichbar.“
End If
End Sub

Gruß
Franz, DF6GL

Ich hab den Code eingesetzt, aber er sagt noch immer, unabhängig davon, ob der Rechner nun ausgeschaltet ist oder nicht, zeigt er immer nur die Meldung „Server ist erreichbar“ an. Wo liegt das Problem?

Mit freundlichen Grüßen,
casjengu

Hallo,

WIE und WO hast Du den Code eingesetzt?

Hast Du beim Computernamen auch die führenden Schrägstriche berücksichtigt?

Gruß
Franz, DF6GL

Guten Tag,

So, ich habe jetzt Fotos von der Tabelle und dem dazugehörigen Formular gemacht. Zusätzlich auch noch ein Foto von dem Code, den du mir geschickt hast udn ich versucht habe einzubauen.

http://imageee.de/uploads/image/new/2012/8/4a00bb37e…

http://imageee.de/uploads/image/new/2012/8/326061e45…

Du erkennst auf dem Formular, dass der 1. PC ausgewählt ist (von 4). Nun soll der Code dafür sorgen, dass er sich von dem ersten PC die IP zieht und ihn dann anpingt. Dafür müsste er die Textbox mit dem Namen „IP_Computeradresse“ und den Inhalt in den Ping-Vorgang einbauen. Und am Ende soll dann die gewünschte Messagebox mit der Nachricht, ob der PC erreichbar oder nicht erreichbar ist, erscheinen.

Bei der Funktion „WoL starten“ liest er auch die MAC-Adresse aus, die für den jeweiligen PC in der Maske (in diesem Fall ist ja gerade der 1. ausgewählt) eingetragen worden ist.

Hast Du vielleicht die Lösung für das Problem?

MfG
casjengu

Hallo,

benutz mal (nur) dieses:

Private Sub Ping1\_Click() 

Dim objPing As Object, objStatus As Object, strcomputer As String

strcomputer = Me!IP\_Computeradresse

Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select \* from Win32\_PingStatus where address = '" & strcomputer & "'")
For Each objStatus In objPing
 If IsNull(objStatus.StatusCode) Or objStatus.StatusCode 0 Then
 MsgBox "Computer " & strcomputer & " nicht erreichbar."
 Else
 MsgBox "Computer " & strcomputer & " ist erreichbar."
 End If
Next


End Sub

Gruß
Franz, DF6GL

1 Like

Hi,

„nur“ dieser Code ist genau das, was ich wollte! :smile:

Vielen Dank, ich hab schon die Hoffnung verloren, aber super von Dir, dass du mir solange geholfen hast, bis das gewünschte Ergebnis rauskam.

Also nochmals danke und liebe Grüße,
casjengu