AW: IP Adresse abfrage
07.08.2018 23:54:04
Werner
Hallo Tobias,
die Suche hier im Forum hilft dir weiter. War gleich der zweite Treffer - der Code ist von Tommy.
Den kompletten Code in ein allgemeines Modul einfügen und das Makro "Start" ausführen. Die IP wird in einer Messagebox ausgegeben und der entsprechende Eintrag im Blatt "Tabelle1" (ggf. anpassen) in der Zelle D5 vorgenommen.
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source _
As Any, ByVal Length As Long)
Public Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, _
ByVal Sort As Long) As Long
Const MAX_IP = 5 'To make a buffer... i dont think you have more than 5 ip on your pc..
Type IPINFO
dwAddr As Long ' IP address
dwIndex As Long ' interface index
dwMask As Long ' subnet mask
dwBCastAddr As Long ' broadcast address
dwReasmSize As Long ' assembly size
unused1 As Integer ' not currently used
unused2 As Integer '; not currently used
End Type
Type MIB_IPADDRTABLE
dEntrys As Long 'number of entries in the table
mIPInfo(MAX_IP) As IPINFO 'array of IP address entries
End Type
Type IP_Array
mBuffer As MIB_IPADDRTABLE
BufferLen As Long
End Type
Public Function ConvertAddressToString(longAddr As Long) As String
Dim myByte(3) As Byte
Dim Cnt As Long
CopyMemory myByte(0), longAddr, 4
For Cnt = 0 To 2
ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "."
Next Cnt
ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function
Public Sub Start()
Dim Ret As Long, Tel As Long
Dim bBytes() As Byte
Dim Listing As MIB_IPADDRTABLE
Dim IPtext As String
On Error GoTo END1
GetIpAddrTable ByVal 0&, Ret, True
If Ret
Gruß Werner