Cum se creează un instrument de căutare WHOIS prin Excel VBA

Folosind Excel, vă puteți construi cu ușurință propriul instrument de căutare whois. Acest instrument va ajuta dezvoltatorii de site-uri web sau hostcompaniilor să transforme domeniile în clienți potențiali. Acest instrument afișează numele persoanelor sau organizațiilor care dețin diferite domenii.

Descarcă acum

Dacă vrei să starPentru a utiliza software-ul cât mai curând posibil, atunci puteți:

Descărcați software-ul acum

În rest, dacă vrei să faci DIY, poți citi conținutul de mai jos.

Să pregătim GUI

GUI-ul acestui instrument este foarte simplu. După cum se arată în imagine, este suficientă o singură foaie cu anteturile și coloanele necesare. În acest exemplu, pentru un domeniu dat, instrumentul va răzui numele registrantului și organizația registrantului. Pentru a permite utilizatorilor să ruleze macrocomanda, creați un buton pe aceeași foaie.

Să-l facem funcțional

Lipiți scriptul într-un modul nou și atașați sub „whoismacor” la butonul pe care l-am creat pe Sheet1.

Să-l testăm

Adăugați domenii în coloana A și rulați macrocomanda. Valorile vor fi afișate pe coloanele respective.

Modificați-l

Începând de acum, instrumentul afișează 2 anteturi și anume, Numele înregistrării și Organizația înregistrării. Puteți personaliza instrumentul pentru a prelua oricare dintre următoarele antete.

Recuperați fișierul xlsm

Dacă întâmpinați probleme la deschiderea sau salvarea acestui instrument, există modificări mari pe care le aveți fișier Excel corupt și trebuie să-l reparați înainte de a-l folosi.

Scenariu

Sub whoismacro()
    Dim v_lrow As Long
    Application.DisplayStatusBar = True
    v_lrow = Sheets("whois").Range("A" & Rows.Count).End(xlUp).Row
    Dim r As Long
    Dim v_string As String
    For r = 4 To v_lrow
        Application.StatusBar = "Macro is running... Now fetching Registrant Name and Organization info for domain at Row : " & r & " /// Total Rows : " & v_lrow
        Sheets("whois").Range("B" & r).Value = WhoIsName(Sheets("whois").Range("A" & r).Value)
        Sheets("whois").Range("C" & r).Value = WhoIsorganization(Sheets("whois").Range("A" & r).Value)
    Next r
    Application.StatusBar = "Ready"
End Sub
 
Function WhoIsName(v_string As String) As String
    Application.DisplayStatusBar = True
    v_string = Replace(v_string, "http://www.", "")
    v_string = Replace(v_string, "https://www.", "")
    v_string = Replace(v_string, "http://", "")
    v_string = Replace(v_string, "https://", "")
    Dim I As Long
    Dim browobj As Object
    Dim obj1 As Object
    Dim obj2 As Object
    Dim obj3 As Object
    Dim v_website As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim tbl As Object
    Dim rw As Object
    Dim cl As Object
    Dim tabno As Long
    Dim nextrow As Long
    Dim URl As String
    Dim lastRow As Long
    Dim xmlobj As Object
    Dim htmobj As Object
    Dim divobj As Object
    Dim objH3 As Object
    Dim linkobj As Object
    Dim vv_startrow As Integer
    Dim vv_lastrow As Integer
    Application.DisplayAlerts = False
    Application.DisplayStatusBar = True
    URl = "https://www.whois.com/whois/" & v_string
    Set xmlobj = CreateObject("MSXML2.XMLHTTP")
    xmlobj.Open "GET", URl, False
    xmlobj.setRequestHeader "Content-Type", "text/xml"
    xmlobj.setRequestHeader "Cache-Control", "no-cache"
    xmlobj.send
    Set htmobj = CreateObject("htmlfile")
    htmobj.body.innerHTML = xmlobj.responseText
    x = InStr(htmobj.body.innertext, "Registrant Name:")
    y = InStr(x, htmobj.body.innertext, Chr(10))
    WhoIsName = Replace(Mid(htmobj.body.innertext, x, y - x), "Registrant Name:", "")
End Function
 
Function WhoIsorganization(v_string As String) As String
    Application.DisplayStatusBar = True
    v_string = Replace(v_string, "http://www.", "")
    v_string = Replace(v_string, "https://www.", "")
    v_string = Replace(v_string, "http://", "")
    v_string = Replace(v_string, "https://", "")
    Dim I As Long
    Dim browobj As Object
    Dim obj1 As Object
    Dim obj2 As Object
    Dim obj3 As Object
    Dim v_website As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim tbl As Object
    Dim rw As Object
    Dim cl As Object
    Dim tabno As Long
    Dim nextrow As Long
    Dim URl As String
    Dim lastRow As Long
    Dim xmlobj As Object
    Dim htmobj As Object
    Dim divobj As Object
    Dim objH3 As Object
    Dim linkobj As Object
    Dim vv_startrow As Integer
    Dim vv_lastrow As Integer
    Application.DisplayAlerts = False
    Application.DisplayStatusBar = True
    URl = "https://www.whois.com/whois/" & v_string
    Set xmlobj = CreateObject("MSXML2.XMLHTTP")
    xmlobj.Open "GET", URl, False
    xmlobj.setRequestHeader "Content-Type", "text/xml"
    xmlobj.setRequestHeader "Cache-Control", "no-cache"
    xmlobj.send
    Set htmobj = CreateObject("htmlfile")
    htmobj.body.innerHTML = xmlobj.responseText
    x = InStr(htmobj.body.innertext, "Registrant Organization:")
    Debug.Print x
    y = InStr(x, htmobj.body.innertext, Chr(10))
    Debug.Print y
    WhoIsorganization = Replace(Mid(htmobj.body.innertext, x, y - x), "Registrant Organization:", "")
End Function

Introducerea autorului:

Nick Vipond este un expert în recuperarea datelor DataNumen, Inc., care este lider mondial în tehnologiile de recuperare a datelor, inclusiv repara problema docx și produse software de recuperare Outlook. Pentru mai multe informații vizitați www.datanumen.com