DNS und NetBios Abfrage von Hostnamen aus Excel

Wer regelmäßig mit Excel und Hostnamen arbeitet, steht sehr wahrscheinlich irgendwann vor der Aufgabe, Hostnamen per DNS und eventuell auch NetBios in Excel auflösen und die Ergebnisse speichern zu wollen.

Für beide Aufgaben kann man sich wie hier beschrieben passenden VBA-Code zusammenbauen. Jedoch benötigt man für NetBios Abfragen ein Zusatztool von Microsoft.

Nachdem man das Tool heruntergeladen, entpackt und nach %windir%system32 kopiert hat öffnet man das entsprechende Excel-Dokument und drückt Alt+F11 um den VBA Editor zu öffnen. Nun links auf Module rechte Maustaste Einfügen – User Module wählen.

Nun die Code-Schnipsel für nslookup und nblookup dort einfügen. Anschließend kann in die Function =nslookup(A2) bzw. =nblookup(A2) verwendet werden um Hostnamen dynamisch aufzulösen.

Meine Erfahrung zeigt jedoch, dass diese Arbeitsweise bei mehreren hundert Datensätzen Excel sehr langsam macht, da bei jeder Filterung die Funktionen erneut ausgeführt werden. Der DNS Dankt, wenn dies nicht fortlaufend passiert 😉

Um das Problem zu umgehen, kann man die Funktionen auch einzelnen für einen markierten Bereich Aufrufen. Die nachfolgenden Code-Schnipsel führen bei der Ausführung gegen die markierten Hostnamen die Funktion nslookup und nblookup aus und speichern das Ergebnis in der direkt benachbarten Spalte (nslookup) beziehungsweise der danach (nblookup).

Public Function NSLookup(lookupVal As String, Optional addressOpt As Integer) As String
   Const ADDRESS_LOOKUP = 1
   Const NAME_LOOKUP = 2
   Const AUTO_DETECT = 0
   On Error Resume Next

   '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 -type=A " & 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 = "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 + 10, 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 = Replace(namestr, vbLf, "")
    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

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Public Sub RunNSLookup()
Dim oArea As Range
Dim oCell As Range
On Error Resume Next

For Each oArea In Selection.Areas
    For Each oCell In oArea.Cells
        Cells(oCell.Row, oCell.Column + 1) = NSLookup(oCell.Value)
        ActiveSheet.Cells(oCell.Row, oCell.Column + 1).Select
    Next
Next
End Sub

Public Function NBLookup(lookupVal As String, Optional addressOpt As Integer) As String
   Const ADDRESS_LOOKUP = 1
   Const NAME_LOOKUP = 2
   Const AUTO_DETECT = 0
   On Error Resume Next
   
   '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 nblookup " & 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, "Unique", vbTextCompare)
        If intFound = 0 Then
            NBLookup = "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 + 9, 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
        NBLookup = Replace(namestr, vbLf, "")
    Else
        NBLookup = "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

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Public Sub RunNBLookup()
Dim oArea As Range
Dim oCell As Range
On Error Resume Next

For Each oArea In Selection.Areas
    For Each oCell In oArea.Cells
        Cells(oCell.Row, oCell.Column + 2) = NBLookup(oCell.Value)
        ActiveSheet.Cells(oCell.Row, oCell.Column + 1).Select
    Next
Next
End Sub