Ping in Excel and want to add DNS lookup

Dear Sir,

I want to add one more column for DNS lookup in below mention code:

Sub ClearValues()
'ResetValues
Rows("4:5124").Select
Selection.ClearContents
Rows("4:4").Select
End Sub
Sub RunPing()
i = 4
While (ActiveSheet.Cells(i, 1) <> "")
'Retrieve IP Address
strCompAddress = ActiveSheet.Cells(i, 1)

'//Setup Shell command for Ping
'//NOTE: Make to leave a space after PING.exe
Dim strShellCommand As String
strShellCommand = "C:\Windows\System32\PING.exe " + strCompAddress

'//Create Shell Object in to run Scripts
Set oSh = CreateObject("WScript.Shell")
Set oEx = oSh.Exec(strShellCommand)

'//Read output buffer
strBuf = oEx.StdOut.ReadAll
ActiveSheet.Cells(i, 2) = strBuf
i = i + 1
Wend
End Sub