Attempting to use VBA to Ping within Excel...



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 spread***.

**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 objWork***
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


.


Loading