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

Aragon10

XLDnaute Occasionnel
Bonjour le Forum,

J'ai trouvé un code qui me permettait de récupérer l'adresse IP de la machine (code ci dessous) . Je voudrais insérer l'adresse IP de chaque utilisateur ainsi que la date et l'heure d'ouverture du fichier sur ma feuil1. (fichier partagé sur un serveur).

Code:
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

En mettant LocalIPAddress = Range("A1") sur le workbook open l'adresse IP s’insère sur la cellule "A1" (il me manque la date et l'heure sur la cellule "B1"). je veux lorsqu'il s'agit d'une nouvelle adresse IP(nouveau utilisateur), il y'aura insertion de cette nouvelle adresse IP non pas sur "A1" mais sur la cellule ("A2") et la date sur la cellule "B2" et ainsi de suite.. et si l'adresse IP existe déjà sur la colonne A (ancien utilisateur) , il suffit uniquement de changer l'heure sur la même ligne sur la colonne B .

Merci d'avance.
 

Discussions similaires

Réponses
7
Affichages
317
Réponses
2
Affichages
197

Statistiques des forums

Discussions
312 082
Messages
2 085 169
Membres
102 804
dernier inscrit
edaguo