Ինչպես ստեղծել WHOIS- ի որոնման գործիք Excel VBA- ի միջոցով

Excel-ի միջոցով դուք կարող եք հեշտությամբ ստեղծել ձեր սեփական whois որոնման գործիքը: Այս գործիքը կօգնի կայքերի մշակողներին կամ հոսթինգային ընկերություններին դոմեյնները վերածել լիդերի: Այս գործիքը ցուցադրում է տարբեր դոմեյններ ունեցող մարդկանց կամ կազմակերպությունների անունները:

Download Now

Եթե ​​ցանկանում եք սկսել օգտագործել ծրագիրը որքան հնարավոր է շուտ, ապա կարող եք.

Ներբեռնեք ծրագիրը այժմ

Հակառակ դեպքում, եթե ցանկանում եք ինքնուրույն վարվել, կարող եք կարդալ ստորև բերված բովանդակությունը:

Եկեք պատրաստենք GUI

Այս գործիքի GUI- ն շատ պարզ է: Ինչպես ցույց է տրված նկարում, անհրաժեշտ է միայն մեկ թերթ `անհրաժեշտ վերնագրերով և սյուններով: Այս օրինակում, տվյալ Դոմենի համար, գործիքը քերելու է Գրանցվող Անունը և Գրանցվող Կազմակերպությունը: Որպեսզի օգտվողները կարողանան գործարկել մակրոը, նույն թերթիկի վրա ստեղծեք կոճակ:

Եկեք այն դարձնենք ֆունկցիոնալ

Տեղադրեք սցենարը նոր մոդուլի մեջ և կցեք «whoismacor» ենթակետը Sheet1- ում մեր ստեղծած կոճակին:

Եկեք փորձարկենք այն

Ա սյունակում ավելացնել տիրույթներ և գործարկել մակրոը: Արժեքները կցուցադրվեն համապատասխան սյունակների վրա:

Փոփոխել այն

Այս պահի դրությամբ գործիքը ցույց է տալիս 2 վերնագիր, այսինքն ՝ Գրանցվող Անունը և Գրանցվող Կազմակերպությունը: Գործիքը կարող եք հարմարեցնել հետևյալ վերնագրի որևէ մեկը ստանալու համար:

Վերականգնել xlsm ֆայլը

Եթե ​​այս գործիքը բացելու կամ պահպանելու մեջ խնդիրներ ունեք, կան մեծ փոփոխություններ, որոնք դուք ունեք կոռումպացված Excel ֆայլ և դուք պետք է շտկեք այն օգտագործելուց առաջ:

Ձեռագիր

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

Հեղինակի ներածություն.

Nick Vipond- ը տվյալների վերականգման փորձագետ է DataNumen, Inc., որը տվյալների վերականգման տեխնոլոգիաների համաշխարհային առաջատարն է, այդ թվում վերանորոգել docx խնդիրը և հեռանկարների վերականգնման ծրագրային արտադրանքները: Լրացուցիչ տեղեկությունների համար այցելեք www.datanumen.com