Excel VBA ile WHOIS Arama Aracı Nasıl Oluşturulur

Excel'i kullanarak kolayca kendi whois arama aracınızı oluşturabilirsiniz. Bu araç, web sitesi geliştiricilerine veyaostşirketleri etki alanlarını olası satışlara dönüştürmeye yönlendirmek. Bu araç, farklı etki alanlarına sahip kişi veya kuruluşların adlarını görüntüler.

Hemen İndir

eğer istersentart Yazılımı mümkün olan en kısa sürede kullanmak için şunları yapabilirsiniz:

Yazılımı Şimdi İndirin

Aksi takdirde, DIY yapmak istiyorsanız aşağıdaki içeriği okuyabilirsiniz.

GUI'yi hazırlayalım

Bu aracın GUI'si çok basittir. Resimde gösterildiği gibi, gerekli başlıkları ve sütunları içeren tek bir sayfa yeterlidir. Bu örnekte, belirli bir Etki Alanı için araç, Alan Adı Sahibinin Adını ve Alan Adı Sahibi Kuruluşu sıyıracaktır. Kullanıcıların makroyu çalıştırmasına izin vermek için aynı sayfada bir düğme oluşturun.

işlevsel hale getirelim

Komut dosyasını yeni bir modüle yapıştırın ve Sheet1'de oluşturduğumuz butona "whoismacor" alt kodunu ekleyin.

test edelim

A Sütununa etki alanlarını ekleyin ve makroyu çalıştırın. Değerler ilgili sütunlarda görüntülenecektir.

Değiştir

Şu andan itibaren araç 2 başlık gösteriyor, yani, Tescil Ettiren Adı ve Tescil Ettiren Kuruluş. Aşağıdaki başlıklardan herhangi birini almak için aracı özelleştirebilirsiniz.

xlsm dosyasını kurtar

Bu aracı açarken veya kaydederken sorun yaşıyorsanız, sahip olduğunuz yüksek değişiklikler vardır. bozuk Excel dosyası ve kullanmadan önce düzeltmeniz gerekir.

Senaryo

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

Yazar Tanıtımı:

Nick Vipond bir veri kurtarma uzmanıdır. DataNumendahil olmak üzere veri kurtarma teknolojilerinde dünya lideri olan , Inc. docx sorununu onar ve görünüm kurtarma yazılımı ürünleri. Daha fazla bilgi için ziyaret edin www.datanumen.com