WHOIS keresőeszköz létrehozása az Excel VBA segítségével

Az Excel segítségével könnyedén létrehozhatod a saját whois keresőeszközödet. Ez az eszköz segít a weboldalfejlesztőknek vagy tárhelyszolgáltatóknak a domainek leadekké konvertálásában. Az eszköz megjeleníti a különböző domainekkel rendelkező személyek vagy szervezetek nevét.

Töltse le most

Ha a lehető leghamarabb el szeretné kezdeni a szoftver használatát, akkor a következőket teheti:

Töltse le a szoftvert most

Ellenkező esetben, ha barkácsolni szeretne, az alábbiakban olvashatja a tartalmat.

Készítsük elő a GUI-t

Ennek az eszköznek a grafikus felhasználói felülete nagyon egyszerű. Ahogy a képen látható, elegendő egy lap a szükséges fejlécekkel és oszlopokkal. Ebben a példában egy adott tartományhoz az eszköz lekaparja a regisztráló nevét és a regisztráló szervezetét. Ha engedélyezni szeretné a felhasználók számára a makró futtatását, hozzon létre egy gombot ugyanazon a lapon.

Tegyük működőképessé

Illessze be a szkriptet egy új modulba, és csatolja a „whoismacor” alcímet a Sheet1-en létrehozott gombra.

Teszteljük

Adjon hozzá tartományokat az A oszlopban, és futtassa a makrót. Az értékek a megfelelő oszlopokban jelennek meg.

Módosítsa

Jelenleg az eszköz 2 fejlécet mutat, azaz a regisztráló nevét és a regisztráló szervezetét. Testreszabhatja az eszközt a következő fejlécek bármelyikének lekéréséhez.

xlsm fájl helyreállítása

Ha problémába ütközik az eszköz megnyitása vagy mentése során, nagy változások vannak, amelyek a sérült Excel fájl és használat előtt meg kell javítani.

Forgatókönyv

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

Szerző Bevezetés:

Nick Vipond adat-helyreállítási szakértő DataNumen, Inc., amely világelső az adat-helyreállítási technológiák területén, beleértve docx probléma javítása és az Outlook helyreállítási szoftvertermékei. További információért látogasson el www.datanumen.com