WHOIS-hakutyökalun luominen Excel VBA: n kautta

Excelin avulla voit helposti rakentaa oman whois-hakutyökalusi. Tämä työkalu auttaa verkkosivustojen kehittäjiä tai hosting-yrityksiä muuntamaan verkkotunnuksia liideiksi. Tämä työkalu näyttää eri verkkotunnuksia omistavien ihmisten tai organisaatioiden nimet.

Lataa nyt

Jos haluat aloittaa ohjelmiston käytön mahdollisimman pian, voit:

Lataa ohjelmisto nyt

Muussa tapauksessa voit lukea sisällön alla olevasta sisällöstä.

Valmistellaan käyttöliittymä

Tämän työkalun käyttöliittymä on hyvin yksinkertainen. Kuten kuvassa näkyy, riittää vain yksi arkki tarvittavilla otsikoilla ja sarakkeilla. Tässä esimerkissä työkalu raaputtaa tietyn verkkotunnuksen rekisteröijän nimen ja rekisteröijän organisaation. Jotta käyttäjät voivat suorittaa makron, luo painike samalle arkille.

Tehdään siitä toimiva

Liitä komentosarja uuteen moduuliin ja kiinnitä ala "whoismacor" Sheet1: een luomaamme painikkeeseen.

Testataan se

Lisää toimialueita sarakkeeseen A ja suorita makro. Arvot näytetään vastaavissa sarakkeissa.

Muokkaa sitä

Tällä hetkellä työkalu näyttää kaksi otsikkoa eli rekisteröijän nimen ja rekisteröijän organisaation. Voit mukauttaa työkalua hakemaan minkä tahansa seuraavista otsikoista.

Palauta xlsm-tiedosto

Jos sinulla on vaikeuksia avata tai tallentaa tätä työkalua, sinulla on suuria muutoksia vioittunut Excel-tiedosto ja sinun on korjattava se ennen käyttöä.

Käsikirjoitus

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

Tekijän esittely:

Nick Vipond on tietojen palauttamisen asiantuntija DataNumen, Inc., joka on maailman johtava tietojen palautustekniikoissa, mukaan lukien korjaa docx-ongelma ja Outlook-palautusohjelmistotuotteet. Lisätietoja osoitteessa www.datanumen.com