Jak utworzyć narzędzie do wyszukiwania WHOIS za pomocą programu Excel VBA

Za pomocą programu Excel możesz łatwo stworzyć własne narzędzie do wyszukiwania whois. To narzędzie pomoże twórcom stron internetowych lub firmom hostingowym konwertować domeny na potencjalnych klientów. Wyświetla ono nazwy osób lub organizacji posiadających różne domeny.

Pobierz teraz

Jeśli chcesz zacząć korzystać z oprogramowania jak najszybciej, możesz:

Pobierz oprogramowanie teraz

W przeciwnym razie, jeśli chcesz wykonać majsterkowanie, możesz przeczytać poniższą zawartość.

Przygotujmy GUI

GUI tego narzędzia jest bardzo proste. Jak pokazano na obrazku, wystarczy jeden arkusz z niezbędnymi nagłówkami i kolumnami. W tym przykładzie dla danej domeny narzędzie zeskrobuje Nazwę rejestrującego i Organizację rejestrującego. Aby umożliwić użytkownikom uruchamianie makra, utwórz przycisk na tym samym arkuszu.

Zróbmy to funkcjonalnie

Wklej skrypt do nowego modułu i dołącz sub „whoismacor” do przycisku, który stworzyliśmy na Arkuszu1.

Przetestujmy to

Dodaj domeny w kolumnie A i uruchom makro. Wartości zostaną wyświetlone w odpowiednich kolumnach.

Zmodyfikuj to

Obecnie narzędzie pokazuje 2 nagłówki, tj. Nazwę rejestrującego i Organizację rejestrującego. Możesz dostosować narzędzie, aby pobierało dowolny z poniższych nagłówków.

Odzyskaj plik xlsm

Jeśli masz problemy z otwarciem lub zapisaniem tego narzędzia, oznacza to, że masz duże zmiany uszkodzony plik Excela i musisz to naprawić przed użyciem.

Scenariusz

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

Wprowadzenie autora:

Nick Vipond jest ekspertem w dziedzinie odzyskiwania danych w DataNumen, Inc., która jest światowym liderem w technologiach odzyskiwania danych, w tym napraw problem z docx i oprogramowanie do odzyskiwania programu Outlook. po więcej informacji odwiedź www.datanumen.com