VBA EXCEL : insertion de l'adresse IP de la machine

Private Const MAX_ADAPTER_NAME_LENGTH As Long = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8
Private Const ERROR_SUCCESS As Long = 0

Private Type IP_ADDRESS_STRING
    IpAddr(0 To 15) As Byte
End Type

Private Type IP_MASK_STRING
    IpMask(0 To 15) As Byte
End Type

Private Type IP_ADDR_STRING
    dwNext As Long
    IpAddress As IP_ADDRESS_STRING
    IpMask As IP_MASK_STRING
    dwContext As Long
End Type

Private Type IP_ADAPTER_INFO
    dwNext As Long
    ComboIndex As Long  'reserved
   sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3)) As Byte
    sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
    dwAddressLength As Long
    sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1)) As Byte
    dwIndex As Long
    uType As Long
    uDhcpEnabled As Long
    CurrentIpAddress As Long
    IpAddressList As IP_ADDR_STRING
    GatewayList As IP_ADDR_STRING
    DhcpServer As IP_ADDR_STRING
    bHaveWins As Long
    PrimaryWinsServer As IP_ADDR_STRING
    SecondaryWinsServer As IP_ADDR_STRING
    LeaseObtained As Long
    LeaseExpires As Long
End Type

Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _
                                         (pTcpTable As Any, pdwSize As Long) As Long
    
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                               (dst As Any, src As Any, ByVal bcount As Long)
    
Private Function TrimNull(item As String)

Dim pos As Integer

pos = InStr(item, Chr$(0))
If pos Then
    TrimNull = Left$(item, pos - 1)
Else
    TrimNull = item
End If
  
End Function

Public Function LocalIPAddress() As String
    
Dim cbRequired  As Long
Dim buff()      As Byte
Dim Adapter     As IP_ADAPTER_INFO
Dim AdapterStr  As IP_ADDR_STRING
Dim ptr1        As Long
Dim sIPAddr     As String
Dim found       As Boolean
  
GetAdaptersInfo ByVal 0&, cbRequired

If cbRequired > 0 Then
    ReDim buff(0 To cbRequired - 1) As Byte
    If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then
        ptr1 = VarPtr(buff(0))
        Do While (ptr1 <> 0)
            CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
            With Adapter
                sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))
                If Len(sIPAddr) > 0 Then
                    found = True
                    Exit Do
                End If
                ptr1 = .dwNext
            End With
        Loop
    End If
End If

LocalIPAddress = sIPAddr
    
End Function