Ping IP Address and Write Result to next Cell

Hello,

I am wondering if you could help me adapt this code to my workbook example attached?

Basically, I would like to “ping” each computer ip address to check if it is online or offline and then write the result in Column C.

Can anyone help? There needs to be no limit to how many ip addresses the script can ping.

Thanks in advance!

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

intRow = 2

 

Set Fso = CreateObject("Scripting.FileSystemObject")

Set objWorkbook = objExcel.Workbooks.Open("X:\SYSTEMS\Machine_Names.xls")

Set InputFile = objWorkbook

Do Until objExcel.Cells(intRow,1).Value = ""

strComputer = objExcel.Cells(intRow, 1).Value

 

objExcel.Cells(1, 1).Value = "Machine Name"

objExcel.Cells(1, 2).Value = "IP Address"

objExcel.Cells(1, 3).Value = "Status"

 

On Error Resume Next

Set objWMIService = GetObject("winmgmts:\\" &  strComputer & "\root\cimv2")

Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")

For Each objItem in colItems

If Err.Number <> 0 Then

objExcel.Cells(intRow, 2).Value = ""

objExcel.Cells(intRow, 3).Value = "Off Line"

Err.Clear

Else

objExcel.Cells(intRow, 2).Value = objItem.IPAddress

objExcel.Cells(intRow, 3).Value = "On Line"

End If

Next

intRow = intRow + 1

Loop

 

objExcel.Range("A1:C1").Select

objExcel.Selection.Interior.ColorIndex = 19

objExcel.Selection.Font.ColorIndex = 11

objExcel.Selection.Font.Bold = True

objExcel.Cells.EntireColumn.AutoFit

Set objWorkbook = Nothing

 

MsgBox "Done"