Ako vytvoriť vyhľadávací nástroj WHOIS pomocou programu Excel VBA

Pomocou Excelu si môžete jednoducho vytvoriť vlastný vyhľadávací nástroj whois. Tento nástroj pomôže vývojárom webových stránok alebo hostingovým spoločnostiam previesť domény na potenciálnych zákazníkov. Tento nástroj zobrazuje mená ľudí alebo organizácií vlastniacich rôzne domény.

stiahnuť

Ak chcete začať používať softvér čo najskôr, môžete:

Stiahnite si softvér teraz

V opačnom prípade si môžete prečítať obsah uvedený nižšie.

Poďme pripraviť GUI

GUI tohto nástroja je veľmi jednoduché. Ako je znázornené na obrázku, postačuje iba jeden hárok s potrebnými hlavičkami a stĺpcami. V tomto príklade pre danú doménu nástroj vyškriabe meno registrujúceho a organizáciu registrujúceho. Ak chcete používateľom umožniť spustenie makra, vytvorte tlačidlo na rovnakom hárku.

Nech je to funkčné

Prilepte skript do nového modulu a pripojte sub „whoismacor“ k tlačidlu, ktoré sme vytvorili na hárku1.

Poďme to vyskúšať

Pridajte domény do stĺpca A a spustite makro. Hodnoty sa zobrazia v príslušných stĺpcoch.

Upravte to

Od tejto chvíle nástroj zobrazuje 2 hlavičky, tj. Meno registrujúceho a Organizácia registrujúceho. Nástroj môžete prispôsobiť tak, aby načítal ktorúkoľvek z nasledujúcich hlavičiek.

Obnovte súbor xlsm

Ak máte ťažkosti s otvorením alebo uložením tohto nástroja, došlo k veľkým zmenám poškodený súbor programu Excel a pred použitím ho musíte opraviť.

Skript

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

Úvod autora:

Nick Vipond je expert na obnovu dát v DataNumen, Inc., ktorá je svetovým lídrom v oblasti technológií obnovy dát, vrátane opraviť problém docx a výhľadové softvérové ​​produkty na obnovenie. Pre viac informácií navštívte www.datanumen. S