Microsoft 365 Récupération IP

[axel35]

Bonjour,
J'ai dans un fichier toute une liste d'URL et je souhaiterais récupérer l'adresse IP de ces URL
en gros cela donne ça
a1= https://toto.fr
a2=https://tata.com/moi.html
...

je souhaite que dans la colonne B il me donne IP correspondante à la colonne A
dans mon exemple
b1=141.95.173.6
b2=40.81.95.116

 

[JHA]

Bonjour à tous,

Peut-être avec recherchev().

JHA

 

[axel35]

Bonjour,
Merci mais en faite se que je recherche c'est que si je met une autre url dans la colonne A que dans la colonne B il aille faire une sorte de "nslookup" du domaine pour ressortir l'adresse IP

 

[JHA]

Bonjour à tous,

Peux-tu compléter le fichier du post #2 afin de voir ce que tu veux?

JHA

 

[sylvanu]

Bonsoir Axel, JHA,
Un essai en PJ mais guère satisfaisant ... mais qui marche.
En passant par un Shell d'un CMD sur un Ping, on génère un txt temporaire qui contient l' IP.
Le hic est que sur mon PC ça met 3.5s par site analysé. Evidemment ne marche que sur PC . Avec :

Public IP, Site, Fichier, ContenuLigne, NumIp
Private Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const STILL_ACTIVE As Long = &H103
Sub ExtraitIP()
    [B2:C1000].ClearContents
    Fichier = ThisWorkbook.Path & "\IP.txt"     ' Déclaration fichier temporaire
    For L = 2 To [A1000].End(xlUp).Row          ' Pour toutes les lignes
        T0 = Timer
        Site = Cells(L, "A")                    ' On récupère le site
        EcritFichier                            ' On lance un ping dessus
        LireFichier                             ' On lit le fichier, la seconde ligne contient l'IP
        NumIp = Split(Split(ContenuLigne, "[")(1), "]")(0)  ' On extrait l'IP, encadré par [ et ]
        Cells(L, "B") = NumIp                   ' On écrit l'IP
        Cells(L, "C") = Format(Timer - T0, "0.000s")    ' On écrit le temps, à supprimer
    Next L
End Sub
Sub LireFichier()
    On Error GoTo FinLect                       ' Si le site n'existe pas
    IndexFichier = FreeFile()
    Open Fichier For Input As #IndexFichier     'ouvre le fichier
    Line Input #IndexFichier, ContenuLigne      ' 1ere ligne vide
    Line Input #IndexFichier, ContenuLigne      ' 2eme ligne, contient l' IP entouré de [ et ]
    Close #IndexFichier                         ' ferme le fichier
Exit Sub
FinLect:
    ContenuLigne = "xx[Error]xx": Exit Sub      ' Renvoie Erreur car site non trouvé
End Sub
Sub EcritFichier() ' Lance le Shell pour mettre le ping dans un fichier et attend la fin du process Shell
    ' Copyright Faves sur developpez.net
    Dim lIDApp As Long
    Dim lPtrProcess As Long
    Dim lExitCode As Long
    Dim lResult As Long
    lIDApp = Shell("cmd /c ping " & Site & " > " & Fichier)           ' Exécution de l'application externe.
    lPtrProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0&, lIDApp)  ' Récupère le Handle du processus de l'application externe.
    Do                                                                ' Attend la fin de l'exécution du processus.
        lResult = GetExitCodeProcess(lPtrProcess, lExitCode)
        DoEvents
    Loop While lExitCode = STILL_ACTIVE
End Sub
Function FichierExiste(Fichier)
   If Len(Dir(Fichier)) > 0 Then FichierExiste = True Else FichierExiste = False
End Function

 

[sylvanu]

Re,
Une version beaucoup plus rapide ( 0.4s vs 3s ) en utilisant "nslookup" au lieu de "ping"
A noter qu'il existe moult définitions, entre les site qui n'ont qu'un IP, ceux qui ont en ont plein, ça devient complexe à analyser.
A tester pour voir.

 

[VIARD]

Bonjours @axel35 ,@JHA ,@sylvanu

J'ai trouvé un code dans mes archives
je ne l'ai jamais testé, @sylvanu regarde ce que cela vaut.
Cordialement

Jean-Paul

Sub ip()
Dim Fs As Object, Sh As Object, Fich As Object, Wscript, Txt$
'Auteur:arthour973
Set Fs = CreateObject("Scripting.FileSystemObject")
Set Sh = CreateObject("WScript.Shell")
On Error Resume Next
Sh.Run "%comspec% /c ipconfig > C:ip1.txt", 0, True
Sh.Run Wscript.Path & "ipconfig /All /batch C:ip1.txt", 0, True
Sh.Run "c:windowssystem32ipconfig /All /batch C:ip1.txt", 0, True
Sh.Run "ipconfig /All /batch C:ip1.txt", 0, True
On Error GoTo 0

Do While Not Fs.fileexists("C:ip1.txt")
Loop
'---- lire le fichier texte créé par le batch ----
Set Fich = Fs.OpenTextFile("c:ip1.txt", 1, False)
Do While Not Fich.AtEndOfStream
    Txt = Fich.readLine
    If InStr(LCase(Txt), "adresse ip") > 1 Or InStr(LCase(Txt), "ip address") > 1 Then
        Txt = Right(Txt, Len(Txt) - InStr(Txt, ":"))
'       MsgBox txt
        Range("b" & Rows.Count).End(xlUp)(2).Value = LCase(Txt)
    End If
Loop
Fich.Close
'------- ménage -----------
Fs.deletefile "c:ip1.txt"
Set Sh = Nothing
Set Fs = Nothing
End Sub

 

[sylvanu]

Bonjour Viard,
'ipconfig" traite l' IP de son ordinateur, non celui d'un site web à distance.
J'ai testé, la réponse sur mon PC renvoie bien ma propre IP.

 

[axel35]

Bonjour a tous,
d'abord merci pour cette aide bien précieuse toutefois @sylvanu j'ai tester vos macro et j'ai un message d'erreur "Le code contenu dans ce projet doit etre mis à jour pour pouvoir être utilisé dans un système 64bits. Vérifier et mettez à jour les instruction Declare, puis marquez-les avec un attributs PtrSafe"
et la partie qui se trouve en rouge

[COLOR=rgb(184, 49, 47)]Public IP, Site, Fichier, ContenuLigne, NumIp, Col
Private Declare Function OpenProcess Lib "kernel32 " _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel" _
    (ByVal hProcess As Long, lpExitCode As Long) As Long[/COLOR]
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const STILL_ACTIVE As Long = &H103

 

[sylvanu]

Bonjour à tous,
Effectivement je suis sous VBA6 et non VBA7.
J'ai fait le choix initial VBA6/VBA7 mais un peu au pif car impossible pour moi de le tester.
Au début j'ai rajouté un choix VBA7/6 avec :

#If VBA7 Then
    Declare PtrSafe Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As PtrLong
    Declare PtrSafe  Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, lpExitCode As Long) As Long
#Else
    Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As Long
    Declare Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, lpExitCode As Long) As Long
#End If
    Const PROCESS_QUERY_INFORMATION As Long = &H400
    Const STILL_ACTIVE As Long = &H103

Si cela ne marche pas, j'espère que quelqu'un pourra rectifier.

 

[Gégé-45550]

Bonjour à tous,
Effectivement je suis sous VBA6 et non VBA7.
J'ai fait le choix initial VBA6/VBA7 mais un peu au pif car impossible pour moi de le tester.
Au début j'ai rajouté un choix VBA7/6 avec :

#If VBA7 Then
    Declare PtrSafe Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
    ByVal dwProcessId As Long) As PtrLong
    Declare PtrSafe  Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, lpExitCode As Long) As Long
#Else
[QUOTE]

[/QUOTE]
Bonjour sylvanu, axel35, le forum
Dans cette partie, remplacer PtrLong par LongPtr.
Si ça ne marche toujours pas, remplacer en plus Long par LongPtr.
Cordialement,