Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Pingwerte von WebServern auslesen

Gruppe

Internet

Problem

Die Pingwerte einer Liste von WebServern sollen in eine Tabelle eingetragen werden.

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

StandardModule: Modul1

Sub PingHWHSites()
   Dim rng As Range
   Dim v As Variant
   Dim iCounter As Integer
   Dim sTxt As String, sTime As String, sFile As String
   sFile = Application.DefaultFilePath & "\Ping.txt"
   Close
   Set rng = Range("A2")
   Do Until IsEmpty(rng.Value)
      On Error Resume Next
      If InStr(Application.OperatingSystem, "NT") Then
         v = Shell("cmd.exe /C ping " & rng.Value & ">" & sFile)
      Else
         MsgBox "Bitte beachten:" & vbLf & "Die Routine funktioniert" & _
            " nur auf NT-Systemen zuverlässig!"
         v = Shell("command.com /C ping " & rng.Value & ">" & sFile)
      End If
      If Err = 0 Then
         Do
            DoEvents
            AppActivate v
         Loop Until Err <> 0
         On Error GoTo 0
         Open sFile For Input As #1
         Do Until EOF(1)
            Line Input #1, sTxt
            If InStr(sTxt, "Minimum") Then
               sTime = Right(sTxt, Len(sTxt) - InStr(sTxt, "Minimum") - 9)
               sTime = Left(sTime, InStr(sTime, ",") - 1)
               rng.Offset(0, 1).Value = sTime
            End If
            If InStr(sTxt, "Maximum") Then
               sTime = Right(sTxt, Len(sTxt) - InStr(sTxt, "Maximum") - 9)
               sTime = Left(sTime, InStr(sTime, ",") - 1)
               rng.Offset(0, 2).Value = sTime
            End If
            If InStr(sTxt, "Mittelwert") Then
               sTime = Right(sTxt, Len(sTxt) - InStr(sTxt, "Mittelwert") - 11)
               rng.Offset(0, 3).Value = sTime
            End If
         Loop
         Close #1
      Else
         rng.Offset(0, 1) = "Failed to shell"
      End If
      Set rng = rng.Offset(1, 0)
   Loop
End Sub