First of all...thanks for your help Joel...you have posted many great answers
on this forum.

Secondly, unfortunately I'm receiving an Run-time error 1004. It seems to
get hung up on the line of code below Loop:

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

Any ideas?

Thanks again...

"Joel" wrote:

Try this code.

Sub Ping()

Dim objExcel
Dim objWorkbook
Dim objWorkSheet
Dim intRow As Integer
Dim Fso
Dim InputFile
Dim srtComputer
Dim objWMIService
Dim colItems
Dim objItem
Dim strComputer As String

Set objExcel = ThisWorkbook.Sheets("sheet1")
intRow = 2

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 IpAddress 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!"

End Sub


"Andy Dawkins" wrote:

Hello all,
I am attempting to ping a list of machine names listed within Excel 2003.
So far, I have been able to do this by changing some VBS code I found
online. The problem is that the code opens an existing file, but I would
like to have the results stay in the active spreadsheet.

**Warning** I'm a noobie to VBA code...or any code for that matter, so take
it easy on me. :-)

Here's what I have so far...any help you could provide would be awesome.
Thanks!

Sub Ping()

Dim objExcel
Dim objWorkbook
Dim objWorkSheet
Dim intRow As Integer
Dim Fso
Dim InputFile
Dim srtComputer
Dim objWMIService
Dim colItems
Dim objItem
Dim strComputer As String

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
intRow = 2

Set Fso = CreateObject("Scripting.FileSystemObject")
Set objWorkbook = objExcel.Workbooks.Open("U:\My
Documents\Excel\qry_B_ConfigRoom.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 IpAddress 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!"

End Sub