Hostname bzw IP-Adresse in Excel eintragen

' IP to Hostname --- or --- Hostname to IP   
'     
' Version 1.0 26.09.2016 Egon H. Frenz   
'   
Dim strHostname, strIP, strPingResult, IntLatency , a , ZielDatei, WshShell
 
intRow = 2 
Set objExcel = CreateObject("Excel.Application")   
 
With objExcel 
     
    .Visible = True 
    .Workbooks.Add 
     
    .Cells(1, 1).Value = "XXXXXXXXXXXXXXXXXXXXXXXXXXX"   
    .Cells(1, 2).Value = "XXXXXXXXXXXXXX"   
    .Cells(1, 3).Value = "XX.XX.XXXX "  
'   .Cells(1, 4).Value = "                "   
     
    .Range("A1:D1").Select   
    .Cells.EntireColumn.AutoFit 
     
    .Cells(1, 1).Value = "Hostname"   
    .Cells(1, 2).Value = "IP"  
    .Cells(1, 3).Value = date()
         
End With  

'--- Input Text File with either Hostames or IP's ---   

Set Fso = CreateObject("Scripting.FileSystemObject")   
a = inputbox("Gebe die IPadresse / Hostnamen an !")  
Set fso = CreateObject("Scripting.FileSystemObject")  
ZielDatei = "c:\snippings\test.txt"  
Set FileOut = fso.OpenTextFile( ZielDatei, 8, true)
fileOut.WriteLine a

Set InputFile = fso.OpenTextFile("c:\snippings\test.Txt")   
 
Do While Not (InputFile.atEndOfStream) 
     
    strHostname = InputFile.ReadLine 
     
    Set WshShell = WScript.CreateObject("WScript.Shell")   
     
    Call PINGlookup( strHostname, strIP, strPingResult, intLatency ) 
     
    With objExcel 
        .Cells(intRow, 1).Value = strHostname 
        .Cells(intRow, 2).Value = strIP 
'       .Cells(intRow, 3).Value = für später   
'       .Cells(intRow, 4).Value = für später   
    End With 
     
    intRow = intRow + 1 
     
Loop 
 
With objExcel 
    .Range("A1:D1").Select   
    .Selection.Interior.ColorIndex = 19 
    .Selection.Font.ColorIndex = 11 
    .Selection.Font.Bold = True 
    .Cells.EntireColumn.AutoFit 
End With 

 
'------------- Subrutines and Functions ----------------   
 
Sub PINGlookup(ByRef strHostname, ByRef strIP, ByRef strPingResult, ByRef intLatency )  
    ' Both IP address and DNS name is allowed    
    ' Function will return the opposite    
     
    ' Check ob der Hostname eine IP ist   
    Set oRE = New RegExp  
    oRE.Pattern = "^[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}$"    
     
    ' Sort out if IP or Hostname   
    strMachine = strHostname 
    bIsIP = oRE.Test(strMachine)  
    If bIsIP Then  
        strIP = strMachine 
        strHostname = "-------"   
    Else 
        strIP = "-------"   
        strHostname = strMachine 
    End If  
     
     
    ' Get a temp filename and open it   
    Set osShell = CreateObject("Wscript.Shell")   
    Set oFS = CreateObject("Scripting.FileSystemObject")    
    sTemp = osShell.ExpandEnvironmentStrings("%TEMP%")    
    sTempFile = sTemp & "\" & oFS.GetTempName    
     
    ' PING and check if the IP exists   
    intT1 = Fix( Timer * 1000 )  
    osShell.Run "%ComSpec% /c ping -a " & strMachine & " -n 1 > " & sTempFile, 0, True   
    intT2 = Fix( Timer * 1000 )  
    intLatency = Fix( intT2 - intT1 ) / 1000 
     
     
    ' Open the temp Text File and Read out the Data    
    Set oTF = oFS.OpenTextFile(sTempFile)  
     
    ' Parse the temp text file    
    strPingResult = "-------" 'assume failed unless...   
    Do While Not oTF.AtEndoFStream  
         
        strLine = Trim(oTF.Readline)  
        If strLine = "" Then    
            strFirstWord = ""   
        Else  
            arrStringLine = Split(strLine, " ", -1, 1)   
            strFirstWord = arrStringLine(0) 
        End If  
         
        Select Case strFirstWord 
             
            Case "Pinging"    
                If arrStringLine(2) = "with" Then   
                    strPingResult = "-------"   
                    strHostname = "-------"   
                Else 
                    strHostname = arrStringLine(1) 
                    strIP = arrStringLine(2) 
                    strLen = Len( strIP ) - 2 
                    strIP = Mid( strIP, 2, strLen ) 
                    strPingResult = "Ok"   
                End If  
                Exit Do             
            'End Case   
             
            Case "Ping" ' pinging non existent hostname   
                strPingResult = "------"   
                Exit Do     
            'End Case    
                 
        End Select 
         
    Loop  
     
    'Close it    
    oTF.Close  
    'Delete It    
    oFS.DeleteFile sTempFile  
     
     
End Sub
msgbox a 
Set WshShell = WScript.CreateObject ("WScript.Shell")  
WshShell.Run "C:\windows\system32\nslookup.exe"& a  
WshShell = Nothing