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 -

https://www.geekality.net/2016/03/07/excel-function-for-nslookup-in-worksheet/

- 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 -

https://www.mrexcel.com/forum/excel-questions/391426-ping-list-servers-excel.html

- 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