Saturday, 1 September 2018

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


No comments:

Post a Comment