Excel VBA-ээр дамжуулан WHOIS хайх хэрэгслийг хэрхэн яаж үүсгэх вэ

Excel ашиглан та whois хайлтын хэрэгслийг хялбархан бүтээх боломжтой. Энэхүү хэрэгсэл нь вэбсайт хөгжүүлэгчид эсвэл hostкомпаниудыг домэйныг хар тугалга болгон хөрвүүлэх. Энэ хэрэгсэл нь өөр өөр домэйныг эзэмшдэг хүмүүс эсвэл байгууллагын нэрийг харуулдаг.

Одоо Татах

Хэрэв та хүсэж байгаа болtart програмыг аль болох богино хугацаанд ашиглахын тулд дараахь зүйлийг хийж болно.

Програмыг одоо татаж аваарай

Үгүй бол, хэрэв та DIY хийхийг хүсвэл доорхи агуулгыг уншиж болно.

GUI-г бэлдэцгээе

Энэ хэрэгслийн GUI нь маш энгийн. Зураг дээр харуулсны дагуу шаардлагатай толгой ба баганатай ганц хуудас хангалттай. Энэ жишээнд тухайн домэйны хувьд уг хэрэгсэл нь Бүртгүүлэгчийн нэр ба Бүртгүүлэгч байгууллагыг хусах болно. Хэрэглэгчдэд макро ажиллуулахыг зөвшөөрөхийн тулд ижил хуудсан дээр товчлуур үүсгэнэ үү.

Үүнийг функциональ болгоё

Скриптийг шинэ модуль дээр буулгаж, Sheet1 дээр бидний үүсгэсэн товчлуур дээр "whoismacor" дэд хэсгийг хавсаргана уу.

Үүнийг туршиж үзье

А баганад домэйн нэмж, макро ажиллуулна уу. Үнэ цэнэ нь холбогдох багана дээр гарч ирнэ.

Үүнийг өөрчлөх

Одоогийн байдлаар уг хэрэгсэл нь 2 толгой, өөрөөр хэлбэл Бүртгүүлэгчийн нэр ба Бүртгүүлэгч байгууллагыг харуулж байна. Та дараахь толгойн аль нэгийг татаж авахын тулд хэрэгслийг өөрчилж болно.

Xlsm файлыг сэргээнэ үү

Хэрэв та энэ хэрэгслийг нээх эсвэл хадгалахад асуудалтай байгаа бол танд маш их өөрчлөлт орно эвдэрсэн Excel файл үүнийг ашиглахаасаа өмнө засах хэрэгтэй.

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

Зохиогчийн танилцуулга:

Ник Випонд бол мэдээлэл сэргээх мэргэжилтэн юм DataNumen, Үүнд мэдээлэл сэргээх технологиор дэлхийд тэргүүлэгч, Inc. docx-ийн асуудлыг засах болон хэтийн төлөвийг сэргээх програм хангамжийн бүтээгдэхүүнүүд. Дэлгэрэнгүй мэдээллийг авна уу WWW.datanumen.com