EXCEL VBA获取IP

Sub GetIP()
Dim ComputerName As String


ComputerName = "localhost"
Set OpSysSet = GetObject("winmgmts:{impersonationLevel=impersonate}//" & ComputerName).ExecQuery("SELECT index, IPAddress FROM Win32_NetworkAdapterConfiguration")

For Each OpSys In OpSysSet
      If TypeName(OpSys.IPAddress) <> "Null" Then
         For Each IP In OpSys.IPAddress
            MsgBox IP, 64, "IP地址"
         Next
      End If
   Next

End Sub

 

Function bytes2BSTR(vIn)
Dim strReturn As String, ThisCharCode As Long, NextCharCode As Long
Dim i As Long
    strReturn = ""
    For i = 1 To LenB(vIn)
        ThisCharCode = AscB(MidB(vIn, i, 1))
        If ThisCharCode < &H80 Then
            strReturn = strReturn & Chr(ThisCharCode)
        Else
            NextCharCode = AscB(MidB(vIn, i + 1, 1))
            strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
            i = i + 1
        End If
    Next
    bytes2BSTR = strReturn
End Function


Sub ipExternal()
    Dim URL As String, NP, Data, Here As String, Hers As String
    On Error Resume Next
    URL = "http://www.ip138.com/ip2city.asp"
    Set NP = CreateObject("Microsoft.XMLHTTP")
    NP.Open "GET", URL, False
    NP.Send
    Data = NP.responsebody
    Set NP = Nothing
    Data = bytes2BSTR(Data)
    Here = InStrRev(Data, "您的IP地址是：", -1, 0)
    Data = Mid(Data, Here + 9, 13)
    Hers = InStrRev(Data, "<", -1, 0)
    MsgBox Data
End Sub