如何通过 Excel VBA 创建 WHOIS 查询工具

使用 Excel，您可以轻松构建自己的 Whois 查询工具。该工具可以帮助网站开发者或主机托管公司将域名转化为潜在客户。它会显示拥有不同域名的个人或组织的名称。

立即下载

如果您想尽快开始使用该软件，那么您可以：

立即下载软件

否则，如果你想DIY，你可以阅读下面的内容。

让我们准备 GUI

该工具的 GUI 非常简单。 如图所示，只需一张带有必要标题和列的工作表就足够了。 在此示例中，对于给定域，该工具将抓取注册人名称和注册人组织。 要允许用户运行宏，请在同一张纸上创建一个按钮。

让我们让它发挥作用

将脚本粘贴到一个新模块中，并将子“whoismacor”附加到我们在 Sheet1 上创建的按钮。

让我们测试一下

在 A 列中添加域并运行宏。 值将显示在相应的列中。

修改它

到目前为止，该工具显示 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问题 和 outlook 恢复软件产品。 欲了解更多信息，请访问 datanumen.com