nachfolgende Funktion(en) verwende ich unter W2k und Office 2000 zum auslesen der IP. Klappt auch hervorragend.
Unter XP und Office 2003 stürzt Excel bei Aufruf der
Sub testen ab.
Trotz Level gut ist mir das eine Nummer zu hoch.
Bitte um Hilfe
Danke und Gruß, Ingo
Private Type WSAData
wVersion As Integer
wHighVersion As Integer
szDescription(0 To 256)
szSystemStatus(0 To 128)
wMaxSockets As Integer
dwVendorInfo As Long
End Type
Private Declare
Function WSAStartup Lib "WSOCK32.DLL" ( _
ByVal wVersionRequired As Long, _
lpWSAData As WSAData) _
As Long
Private Declare
Function WSACleanup Lib "WSOCK32.DLL" () As Long
Private Declare
Function gethostname Lib "WSOCK32.DLL" ( _
ByVal szHost As String, _
ByVal dwHostLen As Long) _
As Long
Private Declare
Function gethostbyname Lib "WSOCK32.DLL" ( _
ByVal szHost As String) _
As Long
'Achtung: Abgewandelte API-Funktion
Private Declare
Sub CopyMemoryIP Lib "kernel32" Alias "RtlMoveMemory" ( _
hpvDest As Any, _
ByVal hpvSource As Long, _
ByVal cbCopy As Long)
Function GetIPAddress() As String
Dim wsa As WSAData
Dim rVal As Long
Dim sHost As String * 256
Dim lp As Long
Dim lpa As Long
Dim IpAdr(0 To 3) As Byte
rVal = WSAStartup((2 + &H100), wsa)
If rVal = 0 Then
gethostname sHost, 256
lp = gethostbyname(sHost)
If lp Then
CopyMemoryIP lpa, lp + 16, 4
CopyMemoryIP IpAdr(0), lpa, 4
GetIPAddress = CStr(IpAdr(0)) + "." + _
CStr(IpAdr(1)) + "." + _
CStr(IpAdr(2)) + "." + _
CStr(IpAdr(3))
End If
WSACleanup
End If
End Function
Sub testen()
MsgBox GetIPAddress
End Sub