Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Attempting to use VBA to Ping within Excel...
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Attempting to use VBA to Ping within Excel...
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Attempting to use VBA to Ping within Excel...
I'm not getting the error. I think the focus my not be on the present
workbook. try adding this line of code thisworkbook.activate objExcel.Range("A1:c1").Select "Andy Dawkins" wrote: 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Attempting to use VBA to Ping within Excel...
"Joel" wrote:
I'm not getting the error. I think the focus my not be on the present workbook. try adding this line of code "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. On Error Resume Next Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") Set colItems = objWMIService.ExecQuery("Select IpAddress From Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE") The code you posted does not ping remote computers, it tries to connect to a WMI service on remote computers (strComputer), and if it is available gets it's IP address. You can use Win32_PingStatus WMI class to ping remote machines. (It was added for Windows XP, so if you can't use it you can use Ping command instead.) Your code will work, but it is faster to ping a computer first, and only if it is available attempt connecting to remote WMI. Here is some code: Sub Ping() Set Machines = Sheets(1).Range("A1", "A10") For Each Machine In Machines.Cells Debug.Print Machine Set objPing = GetObject _ ("winmgmts:{impersonationLevel=impersonate}"). _ ExecQuery("select * from Win32_PingStatus " & _ "where address = '" & Machine & "'") For Each objStatus In objPing If objStatus.StatusCode = 0 Then Sheets(1).Cells(Machine.Row, Machine.Column + 1) = _ objStatus.StatusCode & " On Line" Else Sheets(1).Cells(Machine.Row, Machine.Column + 1) = _ objStatus.StatusCode & " Off Line" End If Next Next End Sub It connects to local WMI service (no computer name in WMI moniker) and gets ping status for computer names listed in cells A1 - A10. (you can also use IP address instead of computer name). Possible values for objStatus.StatusCode a 0 Success 11001 Buffer Too Small 11002 Destination Net Unreachable 11003 Destination Host Unreachable 11004 Destination Protocol Unreachable 11005 Destination Port Unreachable 11006 No Resources 11007 Bad Option 11008 Hardware Error 11009 Packet Too Big 11010 Request Timed Out 11011 Bad Request 11012 Bad Route 11013 TimeToLive Expired Transit 11014 TimeToLive Expired Reassembly 11015 Parameter Problem 11016 Source Quench 11017 Option Too Big 11018 Bad Destination 11032 Negotiating IPSEC 11050 General Failure (copied from Win32_PingStatus documentation) Hope this helps. -- urkec |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Attempting to use VBA to Ping within Excel...
Thank you urkec for your responce. I noticed that you mentioned that
Win32_PingStatus was added for windows XP. If I'm using Windows 2000 what would I need to do to make it work? Thank you again for your help! Andy "urkec" wrote: "Joel" wrote: I'm not getting the error. I think the focus my not be on the present workbook. try adding this line of code "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. On Error Resume Next Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") Set colItems = objWMIService.ExecQuery("Select IpAddress From Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE") The code you posted does not ping remote computers, it tries to connect to a WMI service on remote computers (strComputer), and if it is available gets it's IP address. You can use Win32_PingStatus WMI class to ping remote machines. (It was added for Windows XP, so if you can't use it you can use Ping command instead.) Your code will work, but it is faster to ping a computer first, and only if it is available attempt connecting to remote WMI. Here is some code: Sub Ping() Set Machines = Sheets(1).Range("A1", "A10") For Each Machine In Machines.Cells Debug.Print Machine Set objPing = GetObject _ ("winmgmts:{impersonationLevel=impersonate}"). _ ExecQuery("select * from Win32_PingStatus " & _ "where address = '" & Machine & "'") For Each objStatus In objPing If objStatus.StatusCode = 0 Then Sheets(1).Cells(Machine.Row, Machine.Column + 1) = _ objStatus.StatusCode & " On Line" Else Sheets(1).Cells(Machine.Row, Machine.Column + 1) = _ objStatus.StatusCode & " Off Line" End If Next Next End Sub It connects to local WMI service (no computer name in WMI moniker) and gets ping status for computer names listed in cells A1 - A10. (you can also use IP address instead of computer name). Possible values for objStatus.StatusCode a 0 Success 11001 Buffer Too Small 11002 Destination Net Unreachable 11003 Destination Host Unreachable 11004 Destination Protocol Unreachable 11005 Destination Port Unreachable 11006 No Resources 11007 Bad Option 11008 Hardware Error 11009 Packet Too Big 11010 Request Timed Out 11011 Bad Request 11012 Bad Route 11013 TimeToLive Expired Transit 11014 TimeToLive Expired Reassembly 11015 Parameter Problem 11016 Source Quench 11017 Option Too Big 11018 Bad Destination 11032 Negotiating IPSEC 11050 General Failure (copied from Win32_PingStatus documentation) Hope this helps. -- urkec |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Attempting to use VBA to Ping within Excel...
"Andy Dawkins" wrote:
Thank you urkec for your responce. I noticed that you mentioned that Win32_PingStatus was added for windows XP. If I'm using Windows 2000 what would I need to do to make it work? I found that code he http://www.rlmueller.net/PingComputers.htm You can find other two samples there, one uses WScript.Shell Exec method to execute the Ping command and then checks it's output to determine if ping was successful. The other uses WScript.Shell Run method. Both will work with Windows 2000 (the first sample requires Windows Script Host 5.6, the other WSH 5.1) If you use WshShell.Exec you won't be able to prevent Command Prompt appearing on the screen, if you use WshShell.Run you will have to write the Ping command output to a temporary txt file, so those are not ideal solutions. The samples are VBScript, VBA the code would look something like this: Function Ping2(ByVal Host As String, _ ByVal Pings As Integer, ByVal TimeOut As Integer) As Boolean Status = CreateObject("WScript.Shell"). _ Exec("%comspec% /c Ping -n " & CStr(Pings) & _ " -w " & CStr(TimeOut) & " " & Host).StdOut.ReadAll 'Debug.Print Status If InStr(Status, "TTL=") = 0 Then Ping2 = False Else Ping2 = True End If End Function Then you can call Ping2 like this: Ping2("ANAME", 1, 750) -- urkec |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Ping from Excel - Almost there | Excel Programming | |||
PING within Excel Cell | Excel Worksheet Functions | |||
Excel Ping Command..via web... | Excel Programming | |||
Ping results into Excel | Excel Programming | |||
ping in excel | Excel Programming |