Using Excel and VBA to NSLookup and Ping Test

After well over a decade in IT and having used Excel on and off for most of that time, I’m only now learning how powerful Excel is!

I have a spreadsheet with a lot of DNS names in, what I want is to get the IP address (do a reverse lookup), and then ping test to see if that address is up or not. Is this possible in Excel? Yes it is!

Before I present the articles that have provided the solutions, here’s an example of a very simple worksheet demonstrating the custom nslookup() and PingResult() functions. There’s also a little bit of Conditional Formatting in there to show Online as green and Offline as red.

Image: Using Excel and VBA to nslookup and Ping Test

In the example above:

On row 2) The nslookup function does an nslookup of 8.8.8.8 and ping test is successful.
On row 3) The nslookup returns the IPv6 address and ping result is unsuccessful (because it’s pinging over IPv6, and PingResult searches for TTL in the output, and IPv6 ping response does not have TTL in the output.)
On row 4) Just a random address and of course it does not resolve and is not pingable.

If you’re just after IPv4 nslookup and ping testing, the functions presented below are perfect. If you want to do stuff with IPv6, they’ll need a little work.

NSLookup

The NSLookup function comes from -
- but the original source is jayteknews.blogspot.com, which is unfortunately now defunct (why it’s so important to copy stuff across the internet!)

PingResult

The PingResult function comes from -
- but the original source is scriptorium.serve-it.nl, which is also unfortunately now defunct.

One change I make is to change the line -

If InStr(sResponse, "Reply From")

- to -

If InStr(sResponse, "TTL")

Excel NSLookup VBA Function - NSLookup()

Note: Copied from the sources above


Public Function NSLookup(lookupVal As String, Optional addressOpt As Integer) As String
    Const ADDRESS_LOOKUP = 1
    Const NAME_LOOKUP = 2
    Const AUTO_DETECT = 0
   
    '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
         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
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


Excel PingResult VBA Function - PingResult()

Note: Copied from the sources above


Option Explicit

'Requires references to Microsoft Scripting Runtime and Windows Script Host Object Model.
'Set these in Tools - References in VB Editor.

Public Function PingResult(sHost As String) As String
    Dim sResponse As String
   
    sResponse = sPing(sHost)
    If InStr(sResponse, "TTL") Then
        PingResult = "Online"
    Else
        PingResult = "Offline"
    End If
   
End Function

Private Function sPing(sHost As String) As String

    Dim oFSO As FileSystemObject, oShell As WshShell, oTempFile As TextStream
    Dim sFilename As String
   
    Set oFSO = New FileSystemObject
    Set oShell = New WshShell
   
    sFilename = oFSO.GetTempName
    oShell.Run "%comspec% /c ping -n 1 " & sHost & " > " & sFilename, 0, True
   
    Set oTempFile = oFSO.OpenTextFile(sFilename, ForReading)
    sPing = oTempFile.ReadAll
    oTempFile.Close
    oFSO.DeleteFile (sFilename)

End Function

Public Sub TestPing()
    MsgBox sPing(InputBox("Enter hostname to test"))
End Sub


Comments

  1. Nice, just working on an enterprise DNS project that this will help tremendously with vs export domain resource records and parsing them.

    I am however getting an Compiler Error- Variable Not Defined for ipLookup in the NSLookup function.
    On my test sheet, that is failing, however the PingResult is working and shows that device online.

    Using Excel 2016 with Scripting and Hosting addons enabled.

    Added ipLookup as a String, and now same error for cmdStr.

    Of course might be me, I just inserted 2 modules and pasted each of the sections into a mod.

    ReplyDelete
  2. Hello Booger,
    I've not seen that error. Do these functions work in a fresh workbook?
    I just copied them from the sources listed and they worked for me first time.
    Cheers, VC

    ReplyDelete
  3. Hello everyone, thank you for this script, btw if anyone need only IPv4 adresses change this line in code:
    oShell.Run "cmd /c nslookup -type=A " & lookupVal & " > " & sFilename, 0, True

    Sending greetings from Czech Republic :)

    ReplyDelete
  4. I test this in Excel 2019, and not work. I think this

    Dim oFSO As FileSystemObject, oShell As WshShell, oTempFile As TextStream

    Need a reference..

    Microsoft Scriping RunTime

    ReplyDelete

Post a Comment