方法1：(控件法）

新建工程，在工程中加入Winsock控件和一个按钮控件

代码：

Option Explicit

Private Sub Command1_Click()
MsgBox "当前计算机网卡IP：" & Winsock1.LocalIP
End Sub

方法2：（API法）

新建工程，在工程中加入一个按钮控件

代码：

Option Explicit

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
Private Declare Sub CopyMemoryIP Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

Private Function GetIPAddress() As String
On Error GoTo Z
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
Exit Function
Z:
GetIPAddress = ""
End Function

Private Sub Command1_Click()
Dim ret As String
ret = GetIPAddress
If ret <> "" Then
MsgBox "当前计算机网卡IP：" & ret
End If
End Sub