Ping all machines and results in different excel sheets

When you run the script redirect to output to a text file and read in the results to your spreadsheet.  You willl need to use VBA to do this.
Stephen

>You willl need to use VBA to do this.

I believe that Sharath was hoping you would provide the VBA.

you could use some code like:

Dim ws1 as worksheet
Sub NewSheet()
    Sheets.Add
    ActiveSheet.Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
    ActiveSheet.Name = Format(Now(), "dd-mmm-yyyy")
    Set ws1 = activesheet
    Call YOURPINGMACRO

End Sub

And use ws1 as sheet in your PingMacro

regards,
Jeroen

here is a simple one. OP please adapt/amend

Option Explicit
Dim objPing,objFile,objFSO,objExcel,objSheet,PING
Dim myOutFile,query,Row,Col,PingMachines(2),i,response
Col = 1
Row = 1
PingMachines(0)="127.0.0.1"
PingMachines(1)="134.0.0.1"
Set objFSO=CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Add
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objExcel.Columns(1).ColumnWidth = 16
objExcel.Columns(2).ColumnWidth = 20
objSheet.Cells(1,Col).Value = "Server" 'Contain IP address
objSheet.Cells(1,Col+1).Value = "Date" ''Date Time
objSheet.Cells(1,Col+2).Value = "Response" 'Response of the ping
Row=Row+1
For i=LBound(PingMachines) To UBound(PingMachines) -1
      query="select * from Win32_PingStatus where address ='"& PingMachines(i) & "'"
      Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery(query)
      For Each PING In objPing
        Select Case PING.StatusCode
          Case 0
            response="Reply from " & PING.ProtocolAddress
          Case 11002    
            response="Destination Net Unreachable"
          Case 11003
            response="Destination Net Unreachable"
          Case 11010
            response="Request Timed Out"    
        End Select
        objSheet.Cells(Row,1).Value=PingMachines(i)
        objSheet.Cells(Row,2).Value=Now
        objSheet.Cells(Row,3).Value=response
        Row=Row+1
      Next
Next
objExcel.ActiveWorkbook.SaveAs("c:\temp\test.xls")
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit

Roos01
Can i use ghostdog1 code in excel and use your code.

I am a bit confused on which code to use...

ghostdog74

Can the script take the ip's or machine names from a txt file and change the sheetname to today's date...
So when i repeat the ping it has to create a new sheet and change date to today's date...

Hello bsharath,
I asumed you already had the script for pinging machines on the domain.
The script I gave is creating a new worksheet every day.

You might try this one, where a sheet called: PC Names, contains all the PC names you want to track.

Dim ws1, ws2 As Worksheet
Dim i As Long
Sub NewSheet()
Set ws2 = Sheets("PC Names") 'this sheetc ontains all PC names
RowsA = ws2.Cells(Rows.Count, 1).End(xlUp).Row
    Sheets.Add
    ActiveSheet.Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
    ActiveSheet.Name = Format(Now(), "dd-mmm-yyyy")
    Set ws1 = ActiveSheet
    For i = 2 To RowsA
    If Cells(i, 1) <> "" Then
        Call MYPINGMACRO(Cells(i, 1))
    End If
End Sub

Sub MYPINGMACRO(strComputer)
'http://msdn2.microsoft.com/en-us/library/aa394595.aspx
    'strComputer = Cells(i, 2)
    ws1.Cells(i, 1) = strComputer
    '"ping -n 1 ComputerName >> C:\results.txt".
    Set objShell = CreateObject("WScript.Shell")
    Set objScriptExec = objShell.Exec( _
        "ping -n 2 -w 1000 " & strComputer)
    strPingResults = LCase(objScriptExec.StdOut.ReadAll)
    If InStr(strPingResults, "reply from") Then
        If InStr(strPingResults, "destination net unreachable") Then
            ws1.Cells(i, 2) = strComputer & "did not respond to ping."
        Else
           ws1.Cells(i, 2) = strComputer & " responded to ping."
        End If
    Else
        ws1.Cells(i, 2) = strComputer & " did not respond to ping."
    End If
End Sub

regards,
Jeroen

Hi,

Is this a Macro or vbs script...

This is a macro which should be used in a new module in excel.

I have put the whole code in a new Module and named the sheet (PC Names)
Where should i put the machine names?
Or should i create a file name (PC Names) and run the script...

Should the whole script be in a single Module?

The machine names should be stored in column A of the sheet called PC Names

the script can be p[laced in one module within the VBA editor.

to run the script while reading a textfile need more coding and changes on errors.
If it is easy to add the machinenames in excel then I would prefer that approach.

Jeroen

I get a Compile error.

End Sub

To just reconfirm....Is all this 1 code .I need to put this in 1 module...

Start code......................

Dim ws1, ws2 As Worksheet
Dim i As Long
Sub NewSheet()
Set ws2 = Sheets("PC Names") 'this sheetc ontains all PC names
RowsA = ws2.Cells(Rows.Count, 1).End(xlUp).Row
    Sheets.Add
    ActiveSheet.Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
    ActiveSheet.Name = Format(Now(), "dd-mmm-yyyy")
    Set ws1 = ActiveSheet
    For i = 2 To RowsA
    If Cells(i, 1) <> "" Then
        Call MYPINGMACRO(Cells(i, 1))
    End If
End Sub

Sub MYPINGMACRO(strComputer)
'http://msdn2.microsoft.com/en-us/library/aa394595.aspx
    'strComputer = Cells(i, 2)
    ws1.Cells(i, 1) = strComputer
    '"ping -n 1 ComputerName >> C:\results.txt".
    Set objShell = CreateObject("WScript.Shell")
    Set objScriptExec = objShell.Exec( _
        "ping -n 2 -w 1000 " & strComputer)
    strPingResults = LCase(objScriptExec.StdOut.ReadAll)
    If InStr(strPingResults, "reply from") Then
        If InStr(strPingResults, "destination net unreachable") Then
            ws1.Cells(i, 2) = strComputer & "did not respond to ping."
        Else
           ws1.Cells(i, 2) = strComputer & " responded to ping."
        End If
    Else
        ws1.Cells(i, 2) = strComputer & " did not respond to ping."
    End If
End Sub


End Code......................

I noticed that I forgot the Next statement:

Dim ws1, ws2 As Worksheet
Dim i As Long
Sub NewSheet()
Set ws2 = Sheets("PC Names") 'this sheetc ontains all PC names
RowsA = ws2.Cells(Rows.Count, 1).End(xlUp).Row
    Sheets.Add
    ActiveSheet.Copy After:=Sheets(ActiveWorkbook.Sheets.Count)
    ActiveSheet.Name = Format(Now(), "dd-mmm-yyyy")
    Set ws1 = ActiveSheet
    For i = 2 To RowsA
    If Cells(i, 1) <> "" Then
        Call MYPINGMACRO(Cells(i, 1))
    End If
   Next i 'Forgot about this statement
End Sub

Thanks now it dont get any error.It creates the sheet with todays date but no results in there.
In the sheet Pcname i have some machine names.When i run the Macro it just creates the sheet but no data in it.
Can you even give the time.As if i run the macro mor than once it says duplicate sheet name available.