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.

    excel_module

    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

     

     

    Leave A Reply