Kuidas luua WHOIS-i otsingutööriista Excel VBA kaudu

Exceli abil saate hõlpsalt luua oma WHOIS-otsingu tööriista. See tööriist aitab veebiarendajatel või majutusettevõtetel domeene müügivihjeteks teisendada. See tööriist kuvab erinevate domeenide omanike inimeste või organisatsioonide nimesid.

Download Now

Kui soovite tarkvara võimalikult kiiresti kasutama hakata, saate:

Laadige tarkvara kohe alla

Vastasel juhul, kui soovite ise teha, saate lugeda allpool olevat sisu.

Valmistame GUI ette

Selle tööriista GUI on väga lihtne. Nagu pildil näidatud, piisab ühest lehest vajalike päiste ja veergudega. Selles näites kraabib tööriist antud domeeni jaoks registreerija nime ja registreerija organisatsiooni. Et lubada kasutajatel makro käitada, looge samale lehele nupp.

Teeme selle funktsionaalseks

Kleepige skript uude moodulisse ja lisage lehel Sheet1 loodud nupule alam "whoismacor".

Testime seda

Lisage veergu A domeenid ja käivitage makro. Väärtused kuvatakse vastavates veergudes.

Muutke seda

Praeguse seisuga näitab tööriist 2 päist, st registreerija nimi ja registreerija organisatsioon. Tööriista saate kohandada, et tuua mõni järgmistest päistest.

Taastage xlsm-fail

Kui teil on selle tööriista avamise või salvestamisega probleeme, on teil tehtud suuri muudatusi rikutud Exceli fail ja enne kasutamist peate selle parandama.

Script

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

Autori sissejuhatus:

Nick Vipond on andmete taastamise ekspert DataNumen, Inc., mis on maailmas juhtiv andmete taastamise tehnoloogiate, sealhulgas docx probleemi parandamine ja Outlooki taastamise tarkvaratooted. Lisateabe saamiseks külastage www.datanumenCom