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