修改 VBA 以遍历已知的服务器列表

Question

我找到了一些 VBA 代码来对 Excel 中的 IP 地址进行 nslookup。该网站归@svish所有，完整代码在这里https://www.geekality.net/2016/03/07/excel-function-for-nslookup-in-worksheet/

这是一个 VBA 函数，它使用 =nslookup(cell_reference,response_type) 格式对单元格中包含的 IP 地址执行 nslookup，其中响应是分别由整数 2 和 1 引用的主机名或 IP 地址。 Excel 中的示例公式可能是 =nslookup(a1,2) 以返回单元格 A1 中包含的 IP 地址的主机名

这个 sn-p 似乎是执行查找和处理输出的部分。

    'Run the nslookup command
    sFilename = oFSO.GetTempName
    oShell.Run "cmd /c nslookup " & lookupVal & " > " & sFilename, 0, True
    Set oTempFile = oFSO.OpenTextFile(sFilename, 1)
    Do While oTempFile.AtEndOfStream <> True
        sLine = oTempFile.Readline
        cmdStr = cmdStr & Trim(sLine) & vbCrLf
    Loop
    oTempFile.Close
    oFSO.DeleteFile (sFilename)
   
    'Process the result
    intFound = InStr(1, cmdStr, "Name:", vbTextCompare)
    If intFound = 0 Then
        NSLookup = ""
        Exit Function
    ElseIf intFound > 0 Then
        'TODO: Cleanup with RegEx
        If addressOpt = ADDRESS_LOOKUP Then
            loc1 = InStr(intFound, cmdStr, "Address:", vbTextCompare) + InStr(intFound, cmdStr, "Addresses:", vbTextCompare)
            loc2 = InStr(loc1, cmdStr, vbCrLf, vbTextCompare)
            nameStr = Trim(Mid(cmdStr, loc1 + 8, loc2 - loc1 - 8))
        ElseIf addressOpt = NAME_LOOKUP Then
            loc1 = InStr(intFound, cmdStr, "Name:", vbTextCompare)
            loc2 = InStr(loc1, cmdStr, vbCrLf, vbTextCompare)
            nameStr = Trim(Mid(cmdStr, loc1 + 5, loc2 - loc1 - 5))
        End If
    End If
    NSLookup = nameStr
Else
    NSLookup = "N/A"
End If

我需要能够遍历预定的 DNS 服务器列表，将服务器名称作为参数传递给 nslookup 命令，例如 nslookup IP_To_Resolve DNSServer，然后检查输出是否有效并尝试下一个服务器如果不是

我没有足够的 VBA 知识来阅读这段代码，也不知道在哪里放置循环。任何建议或指示将不胜感激。

---

所以我尝试了一下，并做了以下更改

修改行

oShell.Run "cmd /c nslookup " & lookupVal & " > " & sFilename, 0, True

阅读

oShell.Run "cmd /c nslookup " & lookupVal & " ns1.domain1.com" & " > " & sFilename, 0, True

提供对备用名称服务器运行查询所需的结果

有了这些信息和谷歌，我尝试了以下更改：

在函数的最开始声明一个数组

static Nameservers as String
Nameserver = Array("ns1.domain1.com",ns1.domain2.com",ns1.domain3.com")

然后我添加了一个for循环和一个if语句来检查它是否找到了结果

'Run the nslookup command
For i = 1 To 3
    sFilename = oFSO.GetTempName
    oShell.Run "cmd /c nslookup " & lookupVal & " " & NameServers(i) & " > " & sFilename, 0, True
    Set oTempFile = oFSO.OpenTextFile(sFilename, 1)
    Do While oTempFile.AtEndOfStream <> True
        sLine = oTempFile.Readline
        cmdStr = cmdStr & Trim(sLine) & vbCrLf
    Loop
    oTempFile.Close
    oFSO.DeleteFile (sFilename)
    intFound = InStr(1, cmdStr, "Name:", vbTextCompare)
    If intFound <> 0 Then
        Exit For
    End If
Next i

很遗憾，我遇到了错误

编译错误：预期的数组

在这一行oShell.Run "cmd /c nslookup " & lookupVal & " " & NameServers(i) & " > " & sFilename, 0, True 突出显示NameServers(i)

我做错了什么？

Answer 1

经过反复试验，我通过进行以下修改使其工作。

在开始时添加了一个名称服务器数组

NameServers = Array("ns1.domain1.com" _
   "ns1.domain2.com", _
   "ns1.domain3.com", _
   "ns1.domain4.com", _
   "ns1.domain5.com", _
   "ns1.domain6.com", _
   "ns1.domain7.com")

添加了一个 for 循环

'Run the nslookup command
For i = 1 To 3
    sFilename = oFSO.GetTempName
    oShell.Run "cmd /c nslookup " & lookupVal & " " & NameServers(i) & " > " & sFilename, 0, True
    Set oTempFile = oFSO.OpenTextFile(sFilename, 1)
    Do While oTempFile.AtEndOfStream <> True
        sLine = oTempFile.Readline
        cmdStr = cmdStr & Trim(sLine) & vbCrLf
    Loop
    oTempFile.Close
    oFSO.DeleteFile (sFilename)
    intFound = InStr(1, cmdStr, "Name:", vbTextCompare)
    If intFound <> 0 Then
        Exit For
    End If
Next i

添加 NameServers(i) 作为参数，作为命令的一部分发送到 cmd

oShell.Run "cmd /c nslookup " & lookupVal & " " & NameServers(i) & " > " & sFilename, 0, True

我现在工作的完整代码（虽然有点慢）是：

Public Function NSLookup(lookupVal As String, Optional addressOpt As Integer) As String
   Const ADDRESS_LOOKUP = 1
   Const NAME_LOOKUP = 2
   Const AUTO_DETECT = 0
   NameServers = Array("ns1.domain1.com" _
       "ns1.domain2.com", _
       "ns1.domain3.com", _
       "ns1.domain4.com", _
       "ns1.domain5.com", _
       "ns1.domain6.com", _
       "ns1.domain7.com")

   'Skip everything if the field is blank
   If lookupVal <> "" Then
        Dim oFSO As Object, oShell As Object, oTempFile As Object
        Dim sLine As String, sFilename As String
        Dim intFound As Integer
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Set oShell = CreateObject("Wscript.Shell")
       
        'Handle the addresOpt operand
        'Regular Expressions are used to complete a substring match for an IP Address
        'If an IP Address is found, a DNS Name Lookup will be forced
        If addressOpt = AUTO_DETECT Then
            ipLookup = FindIP(lookupVal)
            If ipLookup = "" Then
                addressOpt = ADDRESS_LOOKUP
            Else
                addressOpt = NAME_LOOKUP
                lookupVal = ipLookup
            End If
        'Do a regular expression substring match for an IP Address
        ElseIf addressOpt = NAME_LOOKUP Then
            lookupVal = FindIP(lookupVal)
        End If
       
        'Run the nslookup command
        For i = 1 To 7
            sFilename = oFSO.GetTempName
            oShell.Run "cmd /c nslookup " & lookupVal & " " & NameServers(i) & " > " & sFilename, 0, True
            Set oTempFile = oFSO.OpenTextFile(sFilename, 1)
            Do While oTempFile.AtEndOfStream <> True
                sLine = oTempFile.Readline
                cmdStr = cmdStr & Trim(sLine) & vbCrLf
            Loop
            oTempFile.Close
            oFSO.DeleteFile (sFilename)
            intFound = InStr(1, cmdStr, "Name:", vbTextCompare)
            If intFound <> 0 Then
                Exit For
            End If
        Next i
            
        
        'Process the result
        intFound = InStr(1, cmdStr, "Name:", vbTextCompare)
        If intFound = 0 Then
            NSLookup = "Not Found"
            Exit Function
        ElseIf intFound > 0 Then
            'TODO: Cleanup with RegEx
            If addressOpt = ADDRESS_LOOKUP Then
                loc1 = InStr(intFound, cmdStr, "Address:", vbTextCompare) + InStr(intFound, cmdStr, "Addresses:", vbTextCompare)
                loc2 = InStr(loc1, cmdStr, vbCrLf, vbTextCompare)
                nameStr = Trim(Mid(cmdStr, loc1 + 8, loc2 - loc1 - 8))
            ElseIf addressOpt = NAME_LOOKUP Then
                loc1 = InStr(intFound, cmdStr, "Name:", vbTextCompare)
                loc2 = InStr(loc1, cmdStr, vbCrLf, vbTextCompare)
                nameStr = Trim(Mid(cmdStr, loc1 + 5, loc2 - loc1 - 5))
            End If
        End If
        NSLookup = nameStr
    Else
        NSLookup = "N/A"
    End If
End Function

Function FindIP(strTest As String) As String
    Dim RegEx As Object
    Dim valid As Boolean
    Dim Matches As Object
    Dim i As Integer
    Set RegEx = CreateObject("VBScript.RegExp")
   
    RegEx.Pattern = "\b(?:\d{1,3}\.){3}\d{1,3}\b"
    valid = RegEx.test(strTest)
    If valid Then
        Set Matches = RegEx.Execute(strTest)
        FindIP = Matches(0)
    Else
        FindIP = ""
    End If
End Function

处理 100 个 IP 地址并不快，大约需要一分钟。我很确定它可以提高效率，但现在它可以工作了。