Office: (Office 365) Aus Excel heraus verschiedene IP Adressen anpingen mit VBA

Helfe beim Thema Aus Excel heraus verschiedene IP Adressen anpingen mit VBA in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo zusammen. Vorweg: VBA kenn ich mich null aus! :-( Mein Ziel erst einmal: In einer Tabelle stehen in der Spalte C von 8 bis 21 verschiedene... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Micha_74, 26. November 2021.

  1. Micha_74 Neuer User

    Aus Excel heraus verschiedene IP Adressen anpingen mit VBA


    Hallo zusammen.
    Vorweg: VBA kenn ich mich null aus! :-(
    Mein Ziel erst einmal: In einer Tabelle stehen in der Spalte C von 8 bis 21 verschiedene IP-Adressen.
    Per Klick auf einen Button soll dann ein Makro gestartet werden, was die IP Adressen jeweils anpingt. Wiederholend! Neben den IP Adressen (also in Spalte D ) soll einmal "Online" oder "Offline" stehen und in Spalte E die jeweilige Pingzeit (ms).
    Jetzt kommt das Problem bzw. die Probleme.
    1) Im Internet fand ich diverse Beispiele dazu. Allerdings nutzen alle dieses Skript dazu:
    Code:
    Function Ping(strip)
    Dim objshell, boolcode
    Set objshell = CreateObject("Wscript.Shell")
    boolcode = objshell.Run("ping -n 1 -w 1000 " & strip, 0, True)
    If boolcode = 0 Then
    Ping = True
    Else
    Ping = False
    End If
    End Function
    Dies kann ich aber nicht verwenden, da bei uns in der Domäne der Virenschutz dies verhindert. Also fand ich eine andere Alternative mit dieser Codevariante
    Code:
    Set wmi = GetObject("winmgmts://./root/cimv2")
    qry = "select * FROM Win32_Pingstatus WHERE address='" & target & "'"
    
    Da meckert der Virenschutz nicht. Mit etwas selbstgebastelt habe ich es dann auch hinbekommen. Allerdings bekomme ich dann immer nach einer Weile einen Überlauffehler oder "Nicht genügend Stapelspeicher". Wie gesagt, habe ich mir aus diversen Internetseiten da selbst was zusammengebastelt was sicherlich primitiv und kompliziert ist.

    Wie müsste der Code aussehen, wo ich mit der WMI Variante arbeite und es mir die IPs aus C8:C21 anpingt und daneben mir die Ergebnisse anzeigt. Und zwar in Dauerschleife bis ich mit einem Button es wieder stoppe? Ich dreh nämlich langsam echt durch weil ich es nicht hinbekomme:-(

    So sieht mein kompletter Code gerade aus:
    Code:
    Sub start()
    Tabelle1.Range("e8:e21").ClearContents
    Tabelle1.Range("G8").ClearContents
    t = Timer + 10
    pinging (t)
    
    End Sub
    
    Function rsp_time(target)
    Set wmi = GetObject("winmgmts://./root/cimv2")
    qry = "select * FROM Win32_Pingstatus WHERE address='" & target & "' And timeout = 4000"
    rsptime = 1
    CNT = 1
    For Each pingstatus In wmi.execquery(qry)
    If pingstatus.statuscode = 0 Then
    rsptime = rsptime + pingstatus.responseTime
    CNT = CNT + 1
    End If
    Next
    rsp_time = rsptime / CNT
    End Function
    
    Function pinging(s)
    If Tabelle1.Range("G8").Value = "Angehalten" Then
    Exit Function
    End If
    Tabelle1.Range("G8").Value = "Aktiv"
    t = Timer
    
    If s = t Then
    Exit Function
    End If
    
    Do Until Timer = t + 1
    DoEvents
    Loop
    Dim target As String
    
    target = Tabelle1.Range("c8").Value
    Set rngl = Tabelle1.Range("E8")
    lr = rngl.Count
    Tabelle1.Cells(8, 5).Value = rsp_time(target)
    For x = lr To 2 Step -1
    Tabelle1.Cells(1 + x, 1).Value = Tabelle1.Cells(x, 1).Value
    Next
    
    target = Tabelle1.Range("c9").Value
    Set rngl = Tabelle1.Range("E9")
    lr2 = rngl.Count
    Tabelle1.Cells(9, 5).Value = rsp_time(target)
    
    For x2 = lr To 2 Step -1
    Tabelle1.Cells(1 + x2, 1).Value = Tabelle1.Cells(x2, 1).Value
    Next
    
    target = Tabelle1.Range("c10").Value
    Set rngl = Tabelle1.Range("e10")
    lr3 = rngl.Count
    Tabelle1.Cells(10, 5).Value = rsp_time(target)
    For x3 = lr3 To 2 Step -1
    Tabelle1.Cells(1 + x3, 1).Value = Tabelle1.Cells(x3, 1).Value
    Next
    
    target = Tabelle1.Range("c11").Value
    Set rngl = Tabelle1.Range("e11")
    lr3 = rngl.Count
    Tabelle1.Cells(11, 5).Value = rsp_time(target)
    For x4 = lr4 To 2 Step -1
    Tabelle1.Cells(1 + x4, 1).Value = Tabelle1.Cells(x4, 1).Value
    Next
    
    target = Tabelle1.Range("c12").Value
    Set rngl = Tabelle1.Range("e12")
    lr5 = rngl.Count
    Tabelle1.Cells(12, 5).Value = rsp_time(target)
    For x5 = lr5 To 2 Step -1
    Tabelle1.Cells(1 + x5, 1).Value = Tabelle1.Cells(x5, 1).Value
    Next
    
    target = Tabelle1.Range("c13").Value
    Set rngl = Tabelle1.Range("e13")
    lr6 = rngl.Count
    Tabelle1.Cells(13, 5).Value = rsp_time(target)
    For x6 = lr6 To 2 Step -1
    Tabelle1.Cells(1 + x6, 1).Value = Tabelle1.Cells(x6, 1).Value
    Next
    
    target = Tabelle1.Range("c14").Value
    Set rngl = Tabelle1.Range("e14")
    lr7 = rngl.Count
    Tabelle1.Cells(14, 5).Value = rsp_time(target)
    For x7 = lr7 To 2 Step -1
    Tabelle1.Cells(1 + x7, 1).Value = Tabelle1.Cells(x7, 1).Value
    Next
    
    target = Tabelle1.Range("c15").Value
    Set rngl = Tabelle1.Range("e15")
    lr8 = rngl.Count
    Tabelle1.Cells(15, 5).Value = rsp_time(target)
    For x8 = lr8 To 2 Step -1
    Tabelle1.Cells(1 + x8, 1).Value = Tabelle1.Cells(x8, 1).Value
    Next
    
    target = Tabelle1.Range("c16").Value
    Set rngl = Tabelle1.Range("e16")
    lr8 = rngl.Count
    Tabelle1.Cells(16, 5).Value = rsp_time(target)
    For x9 = lr9 To 2 Step -1
    Tabelle1.Cells(1 + x9, 1).Value = Tabelle1.Cells(x9, 1).Value
    Next
    
    target = Tabelle1.Range("c17").Value
    Set rngl = Tabelle1.Range("e17")
    lr8 = rngl.Count
    Tabelle1.Cells(17, 5).Value = rsp_time(target)
    For x10 = lr10 To 2 Step -1
    Tabelle1.Cells(1 + x10, 1).Value = Tabelle1.Cells(x10, 1).Value
    Next
    
    target = Tabelle1.Range("c18").Value
    Set rngl = Tabelle1.Range("e18")
    lr8 = rngl.Count
    Tabelle1.Cells(18, 5).Value = rsp_time(target)
    For x11 = lr11 To 2 Step -1
    Tabelle1.Cells(1 + x11, 1).Value = Tabelle1.Cells(x11, 1).Value
    Next
    
    target = Tabelle1.Range("c19").Value
    Set rngl = Tabelle1.Range("e19")
    lr8 = rngl.Count
    Tabelle1.Cells(19, 5).Value = rsp_time(target)
    For x12 = lr12 To 2 Step -1
    Tabelle1.Cells(1 + x12, 1).Value = Tabelle1.Cells(x12, 1).Value
    Next
    
    target = Tabelle1.Range("c20").Value
    Set rngl = Tabelle1.Range("e20")
    lr8 = rngl.Count
    Tabelle1.Cells(20, 5).Value = rsp_time(target)
    For x13 = lr13 To 2 Step -1
    Tabelle1.Cells(1 + x13, 1).Value = Tabelle1.Cells(x13, 1).Value
    Next
    
    target = Tabelle1.Range("c21").Value
    Set rngl = Tabelle1.Range("e21")
    lr8 = rngl.Count
    Tabelle1.Cells(21, 5).Value = rsp_time(target)
    For x14 = lr14 To 2 Step -1
    Tabelle1.Cells(1 + x14, 1).Value = Tabelle1.Cells(x14, 1).Value
    Next
    
    Call pinging(s)
    
    End Function
    Sub Stop_ping()
    Tabelle1.Range("G8").Value = "Angehalten"
    End Sub
    
    Danke im Voraus
    Gruß
    Micha
     
    Micha_74, 26. November 2021
    #1
  2. Hallo,

    Du rufst die Funktion Pinging rekursiv immer wieder auf, ohne ein Kriterium für ein Ende zu definieren. Irgendwann ist der Stapelspeicher voll mit den Adessen der Aufrufe.

    Grüße
    Michael
     
    Der Steuerfuzzi, 26. November 2021
    #2
  3. Micha_74 Neuer User
    Hmm, da ich, wie gesagt, null Ahnung von VBA habe: Wie könnte ich es dann lösen, dieses Problem? Welchen Wert müsste ich ändern ?
     
    Micha_74, 26. November 2021
    #3
  4. Fennek hat Ahnung

    Aus Excel heraus verschiedene IP Adressen anpingen mit VBA

    Hallo,

    mit einer API sollte es gehen. Du musst nur die Übergabe der IP verallgemeinern:

    Code:
    Option Explicit
    Private Declare Function gethostbyname Lib "WSOCK32.DLL" _
            (ByVal HostName As String) As Long
             
    Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal _
            wVersionRequired As Long, lpWSAData As WinSocketDataType) _
            As Long
    
    Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
    
    Const WS_VERSION_REQD As Long = &H101&
    
    Private Type HostDeType
        hName As Long
        hAliases As Long
        hAddrType As Integer
        hLength As Integer
        hAddrList As Long
    End Type
    
    Private Type WinSocketDataType
        wversion As Integer
        wHighVersion As Integer
        szDescription(0 To 128) As Byte
        szSystemStatus(0 To 256) As Byte
        iMaxSockets As Integer
        iMaxUdpDg As Integer
        lpszVendorInfo As Long
    End Type
    
    Private Function InitSocketAPI() As Long
        Dim Result As Integer
        Dim SocketData As WinSocketDataType
        InitSocketAPI = WSAStartup(WS_VERSION_REQD, SocketData)
    End Function
    
    
    Private Function Check_Connected(Name As String) As String
        Dim HostDeAddress As Long
      
        HostDeAddress = gethostbyname(Name)
        If HostDeAddress = 0 Then
            Check_Connected = "Keine Verbindung"
         Else
            Check_Connected = "Verbindung besteht"
        End If
       
    End Function
    
    '################## wird dann so aufgerufen ###########
    
    Sub Pruefe_Verbindung()
      If InitSocketAPI = 0 Then
         MsgBox Check_Connected("192.168.178.1") ' hier die IP / oder Website eintragen 
         Call WSACleanup
      Else
         MsgBox ("Socket Error! Die Verbindung kann nicht geprüft werden")
      End If
    End Sub
    
    'http://www.herber.de/forum/archiv/1056to1060/1056144_Per_VBA_pruefen_ob_Online.html
    
    mfg
     
  5. Micha_74 Neuer User
    Danke für das Skript. geht nur leider nicht da 64 Bit. Aber trotzdem Danke. Im Endeffekt müsste ich in mein Skript nur was einbauen, was das Makro selbst wiederholt und ich aber durch Drücken eines anderen Buttons dann stoppen kann. Hatte da auch schon was in der Art mal versucht.Nur konnte ich es nur mit "ESC" taste abbrechen was dann auch eine Fehlermeldung/Fenster erscheinen lässt.
     
    Micha_74, 26. November 2021
    #5
Thema:

Aus Excel heraus verschiedene IP Adressen anpingen mit VBA

Die Seite wird geladen...
  1. Aus Excel heraus verschiedene IP Adressen anpingen mit VBA - Similar Threads - Excel verschiedene Adressen

  2. Summe verschiedener Kategorien ausweisen

    in Microsoft Excel Hilfe
    Summe verschiedener Kategorien ausweisen: Hallo zusammen, ich habe (wieder mal) einige Probleme, was die Formeln in Excel angehen und zu dem Problem was ich habe, habe ich keine konkrete Lösung gefunden, daher hier meine Frage: Ich...
  3. Excel - VB - Inhalte verschiedener Arbeitsmappen zusammenführen

    in Microsoft Excel Hilfe
    Excel - VB - Inhalte verschiedener Arbeitsmappen zusammenführen: Hallo liebe Excel-Profis, ich möchte etwas in Excel umsetzen, was ich nicht hinbekomme. Ich habe hier und in diversen Foren geforscht, ich befürchte vielleicht war da auch schon in Ansätzen die...
  4. Säulendiagramm verschiedene Säulen nach Größe sortieren

    in Microsoft Excel Hilfe
    Säulendiagramm verschiedene Säulen nach Größe sortieren: Hallo zusammen, ich habe folgendes "Problem". Ich habe einen Multiple-Choice Fragebogen mit mehreren Fragen und möchte diesen auswerten. Ich habe nun zwei Fragen mitsamt allen Antworten markiert...
  5. Aufgaben aus einer Excel-Tabelle an verschiedene E-Mail-Adressen verteilen

    in Microsoft Excel Hilfe
    Aufgaben aus einer Excel-Tabelle an verschiedene E-Mail-Adressen verteilen: Hallo Forum, ich bin noch nicht allzu lange registriert, konnte aber bereits viele Hilfen und interessante Ansätze aus den Beiträgen entnehmen, welche mir sehr geholfen haben. In der Hoffnung...
  6. Schnittmenge verschiedener Zeiträume -> mit Summe der Schnittmengentage

    in Microsoft Excel Hilfe
    Schnittmenge verschiedener Zeiträume -> mit Summe der Schnittmengentage: Hallo werte Community, ich habe hier so einiges an tollen Berechnung von Schnittmengen gelesen, leider habe ich nichts für mein Problem gefunden. Vielleicht ist ein schlauer Fuchs oder Füchsin...
  7. Inhalt mit Dropdown aus verschiedenen Excel-Dateien auswählen

    in Microsoft Excel Hilfe
    Inhalt mit Dropdown aus verschiedenen Excel-Dateien auswählen: Hallo zusammen ich möchte ein Lieferantentool per Excel erstellen... Aktueller Stand: Für jeden der aktuell 23 Lieferanten gibt es ein identisch angelegtes Excel-Dokument, in der er...
  8. Datenauswahl verschiedener Registerblätter durch DropDown-Liste

    in Microsoft Excel Hilfe
    Datenauswahl verschiedener Registerblätter durch DropDown-Liste: Hallo liebes Forum, im Zuge der Modernisierung in unserem Unternehmen bin ich aktuell dabei, den innerbetrieblichen Auftragsablauf zu verbessern. Hier bin ich nun an meine Fähigkeitsgrenzen...
Schlagworte:
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden