Récupérer l'adresse IP

Bonjour,

J'assure le suivi des consultations d' un fichier à l'aide de ce code à l'ouverture.

Sub Ecriture_HistoPlan()
    Open "U:\HistoPlan.dat" For Append As #2
    On Error GoTo GestErreur
        Ligne = Right("  " & Application.UserName, 4) & "  -  " & Format(Date, "dd/mm") & "  -  " & Format Time, "hhmm")
        Write #2, Ligne
        Close #2
        Exit Sub
GestErreur:
        MsgBox "Ecriture non effectuée", 64, "informations"
        Close #2
End Sub

Existe il une variable qui me permettrait également de récupérer l'adresse IP de l'ordi depuis lequel le fichier a été ouvert ? Ou est ce plus difficile ?

Merci

Bonjour BastLat,

Voici un code d'Alexandre Lokchine et Romain Puyfoulhoux permettant de récupérer l'adresse IP d'un ordinateur.

Code à mettre dans un module standard :

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

Utiliser ensuite la fonction LocalIPAddress() pour renvoyer l'adresse IP de la machine.

vba-new a écrit :

Bonjour BastLat,

Voici un code d'Alexandre Lokchine et Romain Puyfoulhoux permettant de récupérer l'adresse IP d'un ordinateur.

Ca dépasse de loin mon modeste niveau...

Mais si un copier/coller suffit, ça, je devrais savoir faire

Je teste ça demain !

Merci vba-new !

Salut BastLat,

Je te rassure, ça dépasse mon niveau aussi j'avais vu ce code au cours de mes recherches.

Tu as juste un copier-coller à faire et bien placer la fonction LocalIPAddress().

Impeccable.

Exactement ce que je voulais, et ça marche.

Merci vba-new !