N° pc

If Application.UserName <> "le nom de l'utilisateur" Then Exit Sub

Option Explicit
Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long
Const NoError = 0

Function GetUserName()
     Const lpnLength As Integer = 255
     Dim status As Integer
     Dim lpName, lpUserName As String
     lpUserName = Space$(lpnLength + 1)
     status = WNetGetUser(lpName, lpUserName, lpnLength)
     If status = NoError Then
          lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
     Else
          MsgBox "Impossible d'obtenir le login."
          End
     End If
     GetUserName = lpUserName
End Function

Option Explicit

Sub TrouveIP()
 MsgBox "L'adresse IP de ce poste est : " & IP_Adresse()
 
End Sub

Function IP_Adresse()
  'M.Pierron MPFE
  Dim ws As Object, fso As Object, Env As Object, ts As Object
  Dim wFile As String, IP As String

  Set ws = CreateObject("WScript.Shell")
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set Env = ws.Environment("PROCESS")
  If Env("OS") = "Windows_NT" Then
    wFile = fso.gettempname
    ws.Run "%comspec% /c ipconfig > " & wFile, 0, True
  Else
    wFile = "winipcfg.out"
    ws.Run "winipcfg /batch", 0, True
  End If
  Set ws = Nothing
  Set ts = fso.opentextfile(wFile)
  Do While Not ts.AtEndOfStream
    IP = ts.Readline
    If InStr(1, IP, "Adresse IP", 1) <> 0 Then
      IP = Right(IP, Len(IP) - InStr(1, IP, ":", 1) - 1)
      IP_Adresse = Left(IP, Len(IP) - 1)
      Exit Do
    End If
  Loop
  ts.Close
  Set ts = Nothing
  fso.deletefile wFile
  Set fso = Nothing
End Function

Function GetUserName()
    GetUserName = Environ("USERNAME")
End Function