AW: Anpingen + IP-Rückgabe
21.12.2010 10:01:00
Tino
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