Cara Membuat Alat Pencarian WHOIS melalui Excel VBA

Bagikan sekarang:

Dengan menggunakan Excel, Anda dapat dengan mudah membuat alat pencarian whois sendiri. Alat ini akan membantu pengembang situs web atau perusahaan hosting untuk mengubah domain menjadi prospek. Alat ini menampilkan nama orang atau organisasi yang memiliki berbagai domain.

Unduh Sekarang

Jika Anda ingin mulai menggunakan perangkat lunak sesegera mungkin, Anda dapat melakukan hal berikut:

Unduh Perangkat Lunak Sekarang

Kalau tidak, kalau mau DIY bisa baca isinya di bawah ini.

Mari persiapkan GUI

GUI alat ini sangat sederhana. Seperti yang ditunjukkan pada gambar, hanya satu lembar dengan header dan kolom yang diperlukan sudah cukup. Dalam contoh ini, untuk Domain tertentu, alat akan mengikis Nama Pendaftar dan Organisasi Pendaftar. Untuk mengizinkan pengguna menjalankan makro, buat tombol di lembar yang sama.Siapkan GUI Untuk Alat

Mari kita membuatnya berfungsi

Tempel skrip ke modul baru dan lampirkan sub "whoismacor" ke tombol yang kita buat di Sheet1.

Mari kita uji

Tambahkan domain di Kolom A dan jalankan makro. Nilai akan ditampilkan di kolom masing-masing.Tambahkan Domain Di Kolom A Dan Jalankan Makro

Ubah itu

Saat ini alat tersebut menunjukkan 2 tajuk yaitu Nama Pendaftar dan Organisasi Pendaftar. Anda dapat menyesuaikan alat untuk mengambil salah satu tajuk berikut.Ambil Header

Pulihkan file xlsm

Jika Anda mengalami masalah dalam membuka atau menyimpan alat ini, ada perubahan besar yang Anda miliki file Excel yang rusak dan Anda harus memperbaikinya sebelum menggunakannya.

Naskah

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

Pengantar Penulis:

Nick Vipond adalah pakar pemulihan data di DataNumen, Inc., yang merupakan pemimpin dunia dalam teknologi pemulihan data, termasuk memperbaiki masalah docx dan produk perangkat lunak pemulihan prospek. Untuk informasi lebih lanjut kunjungi www.datanumen.com

Bagikan sekarang:

Komentar ditutup.