Start Free Trial

asked on

Pinging and not pinging from excel.

Hi,

I have my asets file.Which has the machine names in Colum Q.Is there a way that when run Macro it shows if the machine is pinging or not.I need a very fast output.As there are a lot of machine in Colum Q.

Any Fping command to achieve this through Excel.

Regards
Sharath

I belive this is a duplicated Q.

https://www.experts-exchange.com/questions/22838997/Ping-from-Excel.html

ASKER

No Both are different questions.Thats the post for showing ip addresses.This one to show if the machine is pinging or not pinging

ASKER

Here is a script that works fast but takes the input of the machines from a txt file.If this can be changed to an excel macro taking inputs from the excel.And even putting the outputs to the machine.that would be great

Set objExcel = CreateObject("Excel.Application")
 
objExcel.Visible = True
 
objExcel.Workbooks.Add
 
intRow = 2
 
objExcel.Cells(1, 1).Value = "Machine Name"
 
objExcel.Cells(1, 2).Value = "On Line"
 
objExcel.Cells(1, 3).Value = "Off Line"
 
 
Set Fso = CreateObject("Scripting.FileSystemObject")
 
Set InputFile = fso.OpenTextFile("servers.txt")
 
 
 
Do While Not (InputFile.atEndOfStream)
 
HostName = InputFile.ReadLine
 
 
 
Set WshShell = WScript.CreateObject("WScript.Shell")
 
Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)
 
 
 
objExcel.Cells(intRow, 1).Value = HostName
 
 
 
Select Case Ping
 
Case 0 objExcel.Cells(intRow, 2).Value = "On Line"
 
Case 1 objExcel.Cells(intRow, 3).Value = "Off Line"
 
End Select
 
 
 
intRow = intRow + 1
 
Loop
 
 
 
objExcel.Range("A1:B1:C1").Select
 
objExcel.Selection.Interior.ColorIndex = 19
 
objExcel.Selection.Font.ColorIndex = 11
 
objExcel.Selection.Font.Bold = True
 
objExcel.Cells.EntireColumn.AutoFit

Open in new window

ASKER

Here is a script that works fast but takes the input of the machines from a txt file.If this can be changed to an excel macro taking inputs from the excel.And even putting the outputs to the machine.that would be great

Set objExcel = CreateObject("Excel.Application")
 
objExcel.Visible = True
 
objExcel.Workbooks.Add
 
intRow = 2
 
objExcel.Cells(1, 1).Value = "Machine Name"
 
objExcel.Cells(1, 2).Value = "On Line"
 
objExcel.Cells(1, 3).Value = "Off Line"
 
 
Set Fso = CreateObject("Scripting.FileSystemObject")
 
Set InputFile = fso.OpenTextFile("servers.txt")
 
 
 
Do While Not (InputFile.atEndOfStream)
 
HostName = InputFile.ReadLine
 
 
 
Set WshShell = WScript.CreateObject("WScript.Shell")
 
Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)
 
 
 
objExcel.Cells(intRow, 1).Value = HostName
 
 
 
Select Case Ping
 
Case 0 objExcel.Cells(intRow, 2).Value = "On Line"
 
Case 1 objExcel.Cells(intRow, 3).Value = "Off Line"
 
End Select
 
 
 
intRow = intRow + 1
 
Loop
 
 
 
objExcel.Range("A1:B1:C1").Select
 
objExcel.Selection.Interior.ColorIndex = 19
 
objExcel.Selection.Font.ColorIndex = 11
 
objExcel.Selection.Font.Bold = True
 
objExcel.Cells.EntireColumn.AutoFit

Open in new window

Hi all,

I think what you are looking for is here:

https://www.experts-exchange.com/questions/22838997/Ping-from-Excel.html

i am using it, it's great

ASKER

dr_ggm
As you can see that jpaulino also recomended the post but that did not work...

It worked for me !!

Can you please upload your sample file, and explain what exactly you need to do ??

>> It worked for me !!
For me to dr_ggm

ASKER

Here is the atached file
Ping-Machines-In-ColumQ.xls

Dear bsharath
Check this file

Run the macro to do the required task (resolve, ping or both) on the selected range

replace Selection with Range("Q2", "Q100") in the function to refer to your range
if you don't want to select the range befor pinging

let me know how it turns out

thanks

IP-ping.xls

ASKER

Which macro should i run for all i get a compile error...

ASKER

Which macro should i run for all i get a compile error...

Try this code.

Regards,

Rob.

Sub Ping_Machines()
    Set WshShell = CreateObject("WScript.Shell")
    For intRow = 2 To Cells(65536, "Q").End(xlUp).Row
        strHostName = Cells(intRow, "Q").Value
        If Trim(Cells(intRow, "AS").Value) = "" Then
            intPing = WshShell.Run("ping -n 1 " & strHostName, 0, True)
            Select Case intPing
                Case 0
                    Cells(intRow, "AT").Value = "On Line"
                    Set objWMIService = GetObject("winmgmts:" _
                        & "{impersonationLevel=impersonate}!\\" & strHostName & "\root\cimv2")
                    Set colComputerIP = objWMIService.ExecQuery _
                        ("Select * from Win32_NetworkAdapterConfiguration")
                    For Each IPConfig In colComputerIP
                        If Not IsNull(IPConfig.IPAddress) Then
                            'strIPAddress = strIPAddress & IPConfig.Description & ": "
                            For intIPCount = LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)
                                'strIPAddress = strIPAddress & "IP Address: " & IPConfig.IPAddress(intIPCount) & "~"
                                strIPAddress = strIPAddress & IPConfig.IPAddress(intIPCount) & "~"
                            Next
                        End If
                    Next
                    
                    If Right(strIPAddress, 1) = "~" Then
                        strIPAddress = Left(strIPAddress, Len(strIPAddress) - 1)
                    End If
                    Cells(intRow, "AS").Value = strIPAddress
                Case 1
                    Cells(intRow, "AT").Value = "Off Line"
            End Select
        End If
    Next
    MsgBox "Finished."
End Sub

Open in new window

ASKER

For few it worked fine then got this message...

ScreenShot018.bmp

Oh yeah, no error checking....try this.

Regards,

Rob.

Sub Ping_Machines()
    Set WshShell = CreateObject("WScript.Shell")
    For intRow = 2 To Cells(65536, "Q").End(xlUp).Row
        strHostName = Cells(intRow, "Q").Value
        If Trim(Cells(intRow, "AS").Value) = "" Then
            intPing = WshShell.Run("ping -n 1 " & strHostName, 0, True)
            Select Case intPing
                Case 0
                    Cells(intRow, "AT").Value = "On Line"
                    On Error Resume Next
                    Set objWMIService = GetObject("winmgmts:" _
                        & "{impersonationLevel=impersonate}!\\" & strHostName & "\root\cimv2")
                    If Err.Number = 0 Then
	                    Set colComputerIP = objWMIService.ExecQuery _
	                        ("Select * from Win32_NetworkAdapterConfiguration")
	                    For Each IPConfig In colComputerIP
	                        If Not IsNull(IPConfig.IPAddress) Then
	                            'strIPAddress = strIPAddress & IPConfig.Description & ": "
	                            For intIPCount = LBound(IPConfig.IPAddress) To UBound(IPConfig.IPAddress)
	                                'strIPAddress = strIPAddress & "IP Address: " & IPConfig.IPAddress(intIPCount) & "~"
	                                strIPAddress = strIPAddress & IPConfig.IPAddress(intIPCount) & "~"
	                            Next
	                        End If
	                    Next
	                    
	                    If Right(strIPAddress, 1) = "~" Then
	                        strIPAddress = Left(strIPAddress, Len(strIPAddress) - 1)
	                    End If
	                    Cells(intRow, "AS").Value = strIPAddress
	               Else
	               		Err.Clear
	               		On Error GoTo 0
	               		Cells(intRow, "AT").Value = "No Access"
	               End If
                Case 1
                    Cells(intRow, "AT").Value = "Off Line"
            End Select
        End If
    Next
    MsgBox "Finished."
End Sub

Open in new window

ASKER

Rob should i have Domain Admin rights for this macro?

Yes, you probably would, to be able to obtain the IP address from the computer directly....

Regards,

Rob.

ASKER

Rob i dont get the Ipaddresses...IN COLUM "AS"
Just
ONLINE
OFFLINE
NO ACCESS ( What does no access mean)

ASKER

Rob i tried from a Domain Admin permissions machines i get it right now.But the ip's are more than 1.
I get 3 set's of ip's in each cell

ASKER

Rob i tried from a Domain Admin permissions machines i get it right now.But the ip's are more than 1.
I get 3 set's of ip's in each cell

Are they different IP Addresses? There may be more than one network card on the machines....

Rob.

ASKER

Rob for 1 machine i get so many.
They are all 1 network card machines.
The real ip when i ping is this.
"129.110.176.135"

But i get this
129.110.176.135129.110.179.200129.110.177.84

Oh, I forgot to "reset" the IP Addresses, so it just keeps appending, and gets bigger every PC....add this line:
strIPAddress = ""

underneath this line:
For intRow = 2 To Cells(65536, "Q").End(xlUp).Row

Regards,

Rob.

ASKER

Rob now for some i get 2 or 3 sets of ip's
Before it was for all.Now its for some.
The machines have just 1 network card and even dont have any virtual network cards.

ASKER

Rob now for some i get 2 or 3 sets of ip's
Before it was for all.Now its for some.
The machines have just 1 network card and even dont have any virtual network cards.

OK, well I'm not sure if this would get you the *correct* IP address, but change this:
strIPAddress = strIPAddress & IPConfig.IPAddress(intIPCount) & "~"

to this
strIPAddress = IPConfig.IPAddress(intIPCount)
Exit For

Regards,

Rob.

ASKER

Rob now this works fine.
Can the cell be blank if Colum Q cell is blank.

No Access does this mean the macro run machine does not have permissions?

ASKER

Rob now this works fine.
Can the cell be blank if Colum Q cell is blank.

No Access does this mean the macro run machine does not have permissions?

ASKER

ROb one more thing Can the Query start from Row 3

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

Thanks Rob one more down..

This runs great now...