Microsoft 365 user - nom ordi - ip : insérer dans les cellules de ma feuille

[Usine à gaz]

Bonjour à toutes et à tous

Je bute sur un code et je n'arrive pas à trouver malgré mes recherches.

Je voudrais mettre (à l'ouverture du classeur) des informations dans ma feuille :
User = c'est bon ça fonctionne,
Nom ordi = c'est bon ça fonctionne,
IP = je trouve mais je n'arrive pas à mettre l'info en "B4"
et je ne comprends pas l'info :

Pourriez-vous m'aider ?
Je joins le fichier test.
Un grand merci à toutes et à tous,

 

[patricktoulon]

autant pour moi un vbcrlf non sauté

Sub test5()
    MsgBox GetAddressIP(1)    'argument valable  ;"ip" ou  "ipv4" ou "locale" ou simplement 1 (es 4 fonctionnent) pour l'IPV4
    MsgBox GetAddressIP(2)  'arguments ; "ipv6" ou simplement 2 pour l'IPV6
End Sub

Function GetAddressIP(Request)
    Dim Wsh As Object, Objectexec As Object, Retour$, Tabl
    GetAddressIP = "Error"
    Set Wsh = CreateObject("WScript.Shell")
    Set Objectexec = Wsh.Exec("%comspec% /c ipconfig.exe")
    Retour = LCase(Objectexec.StdOut.readall)
    'Debug.Print Retour ' juste pour voir ce qui est retourné dans le debug
    Tabl = Split(Retour, "adresse")
    Select Case LCase(Request)
    Case 1, "ipv4", "ip", "locale"
        GetAddressIP = Trim(Split(Split(Tabl(2), ".: ")(1), vbCrLf)(0))
    Case 2, "ipv6"
        GetAddressIP = Trim(Split(Split(Tabl(1), ".: ")(1), vbCrLf)(0))
    End Select
End Function

comme ça ça m'aura permis de rectifier un de mes vieux trucs

 

[sylvanu]

Bonjour Lione, Staple, Patrick,
Code post #14
Sur mon PC, la ligne "GetAddressIP(2)" donne : "2a01:e0a:2:a6e0:9735:635d:80f2:b796 "
Mais les deux caractères à la fin ont un code 13 et 10, donc le Trim n'influera pas sur ces deux derniers caractères.
Avec le post #15, résolu. Nos posts se sont croisés.

 

[patricktoulon]

re
Bonjour @sylvanu
oui c'est réglé dans le message précédent

 

[Usine à gaz]

autant pour moi un vbcrlf non sauté

Sub test5()
    MsgBox GetAddressIP(1)    'argument valable  ;"ip" ou  "ipv4" ou "locale" ou simplement 1 (es 4 fonctionnent) pour l'IPV4
    MsgBox GetAddressIP(2)  'arguments ; "ipv6" ou simplement 2 pour l'IPV6
End Sub

Function GetAddressIP(Request)
    Dim Wsh As Object, Objectexec As Object, Retour$, Tabl
    GetAddressIP = "Error"
    Set Wsh = CreateObject("WScript.Shell")
    Set Objectexec = Wsh.Exec("%comspec% /c ipconfig.exe")
    Retour = LCase(Objectexec.StdOut.readall)
    'Debug.Print Retour ' juste pour voir ce qui est retourné dans le debug
    Tabl = Split(Retour, "adresse")
    Select Case LCase(Request)
    Case 1, "ipv4", "ip", "locale"
        GetAddressIP = Trim(Split(Split(Tabl(2), ".: ")(1), vbCrLf)(0))
    Case 2, "ipv6"
        GetAddressIP = Trim(Split(Split(Tabl(1), ".: ")(1), vbCrLf)(0))
    End Select
End Function

comme ça ça m'aura permis de rectifier un de mes vieux trucs

Merci Patrick = c'est bon comme ça
Bjr sylvanu

 

[patricktoulon]

re
j'ai repris le code de @job75 et j'en ai fait une fonction
pareil que l'autre pour les arguments

Sub test2()
MsgBox WMIGetAdressIP(1)
MsgBox WMIGetAdressIP(2)
End Sub

Function WMIGetAdressIP(Request)
    Dim objWMIService As Object, colAdapters As Object, objAdapter As Object
    WMIGetAdressIP = "Error"
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colAdapters = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")

    For Each objAdapter In colAdapters
        Select Case Request
        Case 1, "ipv4", "locale": WMIGetAdressIP = objAdapter.IPAddress(0)
        Case 2, "ipv6": WMIGetAdressIP = objAdapter.IPAddress(1)
        End Select
    Next
End Function

et j'en ai une autre sans le where avec le test enabled tardif en instanceof

Sub test7()
MsgBox WMIGetAdressIP3(1)
MsgBox WMIGetAdressIP3(2)
End Sub

Function WMIGetAdressIP3(request)
GetAddressIP3 = "Error"
Dim NDC as object, elements as object
Set NCD = GetObject("winmgmts:").InstancesOf("Win32_NetworkAdapterConfiguration")

For Each elements In NCD
If elements.IPEnabled Then
 Select Case request
        Case 1, "ipv4", "locale": WMIGetAdressIP3 = elements.IPAddress(0)
        Case 2, "ipv6": WMIGetAdressIP3 = elements.IPAddress(1)
        End Select
End If
Next
End Function

 

[Usine à gaz]

re
j'ai repris le code de @job75 et j'en ai fait une fonction
pareil que l'autre pour les arguments

Sub test2()
MsgBox WMIGetAdressIP(1)
MsgBox WMIGetAdressIP(2)
End Sub

Function WMIGetAdressIP(Request)
    Dim objWMIService As Object, colAdapters As Object, objAdapter As Object
    WMIGetAdressIP = "Error"
    Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
    Set colAdapters = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")

    For Each objAdapter In colAdapters
        Select Case Request
        Case 1, "ipv4", "locale": WMIGetAdressIP = objAdapter.IPAddress(0)
        Case 2, "ipv6": WMIGetAdressIP = objAdapter.IPAddress(1)
        End Select
    Next
End Function

et j'en ai une autre sans le where avec le test enabled tardif en instanceof

Sub test7()
MsgBox WMIGetAdressIP3(1)
MsgBox WMIGetAdressIP3(2)
End Sub

Function WMIGetAdressIP3(request)
GetAddressIP3 = "Error"
Dim NDC as object, elements as object
Set NCD = GetObject("winmgmts:").InstancesOf("Win32_NetworkAdapterConfiguration")

For Each elements In NCD
If elements.IPEnabled Then
 Select Case request
        Case 1, "ipv4", "locale": WMIGetAdressIP3 = elements.IPAddress(0)
        Case 2, "ipv6": WMIGetAdressIP3 = elements.IPAddress(1)
        End Select
End If
Next
End Function

Merci Patrick, tes codes fonctionnent nickel

 

[Staple1600]

Bonsoir

@Usine à gaz
Pour info
Le code de patricktoulon touche aussi à l'invite MSDos
"%comspec%

Sinon PowerShell fait cela très bien en une ligne de code
(sans boucle)
Mais si tu ne touches pas à l'invite MSDos, tu dois éviter comme la peste PS

 

[patricktoulon]

re
bonjour
eviter quoi il a 3/4 fonction prêtes à l'emploi qui lui ont été proposé
il a pas besoin, sauf si ça l'intéresse de tout connaitre du DOS

des deux entre vba et dos si je devais en avoir peur je craindrais plutôt le vba entre nous

 

[Usine à gaz]

re
bonjour
eviter quoi il a 3/4 fonction prêtes à l'emploi qui lui ont été proposé
il a pas besoin, sauf si ça l'intéresse de tout connaitre du DOS

des deux entre vba et dos si je devais en avoir peur je craindrais plutôt le vba entre nous

Bjr Patrick, le Forum
Bien d'accord avec toi

 

[Staple1600]

Bonsoir le fil

[Précisions]
@patricktoulon
Je ne faisais que répondre à ceci

Je ne touche pas, sauf "exceptionnelle exception" à l'invite MSDos.
Quand un code est opérationnel dans mon fichier : 1clic et c'est bon.

Merci à toi pour m'avoir répondu

Lionel ne touche pas au Dos mais un peu quand même
Puisqu ensuite il testera ta proposition du message#12
(avec du bon vieux MSDos dedans même si il est piloté avec VBScript)