Anpingen + IP-Rückgabe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Dominik
Dann mal weitergebastelt !
Teste mal dies:
Option Explicit

Public Sub Aufruf()
    Dim Zelle As Range
    Dim derText As String
    Dim Regex
    Dim M
    Set Regex = CreateObject("vbscript.Regexp")
    With Regex
        .Pattern = "\[[0-9.]+\]"
        For Each Zelle In Range("A1:A2500")
            derText = PingTest(Zelle.Text)
            Set M = .Execute(derText)
            If M.Count > 0 Then
                Zelle.Offset(0, 1) = M(0).Value
            End If
        Next
    End With
End Sub

Function PingTest(strText As String)
    Dim WSHShell As Object
    Dim objExec As Object
    Set WSHShell = CreateObject("WScript.Shell")
    Set objExec = WSHShell.Exec("%comspec% /c Ping " & strText & " -n 1 -w 1000")
    PingTest = objExec.StdOut.readall
End Function

ransi

With Regex .Pattern = "\[[0-9.]+\]" 'heisst: eine[&solange Zahlen und Punkte bis wieder] For Each Zelle In Range("A1:A2500") derText = PingTest(Zelle.Text) Set M = .Execute(derText) 'Suche das Pattern in derText If M.Count > 0 Then ' Zelle.Offset(0, 1) = M(0).Value 'Die erste Funstelle von Pattern in Spalte B schreiben End If Next End With

Hallo,
habe Dir mal was zusammengebastelt.
Quelle: http://www.vbarchiv.net/tipps/details.php?id=258

Option Explicit

Declare Sub CopyMemory Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  hpvDest As Any, _
  ByVal hpvSource As Long, _
  ByVal cbCopy As Long)
  
Declare Function gethostbyname Lib "WSOCK32" ( _
  ByVal szHost As String) As Long

Private Type HOSTENT
  hName As Long
  hAliases As Long
  hAddrType As Integer
  hLen As Integer
  hAddrList As Long
End Type

Sub Lese_IP_()
Dim rngRange As Range
Dim i%, lpHost&, lngIP&
Dim tmpIP() As Byte, varIP
Dim m_Host As HOSTENT

With Sheets("Tabelle1")
    Set rngRange = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
End With

For Each rngRange In rngRange
    With rngRange
        If .Value <> "" Then
              lpHost = gethostbyname(ByVal Replace(.Value, "\", ""))
              
              CopyMemory m_Host, ByVal lpHost, ByVal Len(m_Host)
              CopyMemory lngIP, ByVal m_Host.hAddrList, ByVal 4
            
              Redim tmpIP(1 To m_Host.hLen)
              CopyMemory tmpIP(1), ByVal lngIP, ByVal m_Host.hLen
              
              For i = 1 To m_Host.hLen
                 varIP = varIP & tmpIP(i) & "."
              Next i
              
              If Right$(varIP, 1) = "." Then
                varIP = Left$(varIP, Len(varIP) - 1)
              End If
         End If
          
          .Offset(0, 1).NumberFormat = "@"
          .Offset(0, 1) = varIP
          
          varIP = Empty
    
    End With
Next rngRange

End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

	A
1	www.herber.de
2	www.office-loesung.de
3
4
5
6
7

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread