and another
'************************************************
'**
'** Ping Script
'**
'** Michael Carpenter
'**
'** May 15,2006
'**
'**
'*************************************************
On Error Resume Next
set WshShell = CreateObject("WScript.Shell")
Result = WshShell.Popup("Searching for machine names or IP addresses from list.txt. " & Chr(13) & "This might take a while depending on number of machines you are trying to find" & Chr(13) & "Please Wait...", 6, "Ping Script")
'Gets the directory where script is running from
'and looks for list.txt for IP addresses
Set objShell = CreateObject("Wscript.Shell")
strPath = Wscript.ScriptFullName
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile(strPath)
strFolder = objFSO.GetParentFolderName(objFile)
strInputFile = strFolder & "\list.txt"
'******************************************************************************
Function ReadTextFile(strInputFile)
'Read contents of text file and return array with one element for each line.
On Error Resume Next
Const FOR_READING = 1
Set objFSO = CreateObject(Scripting.FileSystemObject)
If Not objFSO.FileExists(strInputFile) Then
Set objShell = CreateObject("WScript.Shell")
objShell.Run "taskkill /F /IM excel.exe"
WScript.Echo "Input text file " & strInputFile & " not found."
WScript.Quit
End If
Set objTextStream = objFSO.OpenTextFile(strInputFile, FOR_READING)
If objTextStream.AtEndOfStream Then
Set objShell = CreateObject("WScript.Shell")
objShell.Run "taskkill /F /IM excel.exe"
WScript.Echo "Input text file " & strInputFile & " is empty."
WScript.Quit
End If
arrLines = Split(objTextStream.ReadAll, vbCrLf)
objTextStream.Close
ReadTextFile = arrLines
End Function
'******************************************************************************
On Error Resume Next
x = 2
'Open Excel and populate header Information
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Add()
Set objWorksheet = objWorkbook.Worksheets(1)
objWorksheet.Activate
objWorksheet.Name = "Ping Output"
objExcel.Cells(1, 1).Value = "IP Address "
objExcel.Cells(1, 1).Font.Bold = TRUE
objExcel.Cells(1, 1).Font.Size = 12
objExcel.Cells(1, 1).Interior.colorIndex = 15
objExcel.Cells(1, 2).Value = "Reply? "
objExcel.Cells(1, 2).Font.Bold = TRUE
objExcel.Cells(1, 2).Font.Size = 12
objExcel.Cells(1, 2).Interior.colorIndex = 15
Set objRange = objExcel.Range("A1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("B1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
'Ping machines from list and based on reply, enter information in excel
For Each strItem In ReadTextFile(strInputFile)
Set objShell = CreateObject("WScript.Shell")
Set objExec = objShell.Exec("ping.exe -n 2 -w 1000 " & strItem)
strPingResults = LCase(objExec.StdOut.ReadAll)
If InStr(strPingResults, "ttl") Then
objExcel.Cells(x, 1).Value = strItem
objExcel.Cells(x, 2).Value = "Yes"
x = x + 1
Else
objExcel.Cells(x, 1).Value = strItem
objExcel.Cells(x, 2).Value = "No"
x = x + 1
End If
Next
'******************************************************************************
'Make sure that excel is selected
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
' Set the ranges so that we can sort.
Set objRange = objExcel.Range("A:B")
Set objRange2 = objExcel.Range("B3")
' Sort Yes / No
objRange.Sort objRange2,1,,,,,,1
'******************************************************************************
Answer = MsgBox ("Ping Script Complete!" & Chr(13) & Chr(13) & "Select OK to save Excel" & Chr(13) & "Spreadsheet to Script Directory" & Chr(13) & Chr(13) & "Select Cancel to Leave" & chr(13) & "Spreadsheet Open." & Chr(13), 65, "Ping Program")
If Answer = ("1") Then
set WshShell = CreateObject("WScript.Shell")
Result = WshShell.Popup("Saving Speadsheet " & Chr(13) & "Name: Ping_Information.xls" & Chr(13) & "Location: " & strFolder & Chr(13) & "Please Wait...", 8, "Saving to Script directory")
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strFolder & "\Ping_Information.old") Then objFSO.DeleteFile(strFolder & "\Ping_Information.old")
If objFSO.FileExists(strFolder & "\Ping_Information.xls") Then objFSO.MoveFile(strFolder & "\Ping_Information.xls") , (strFolder & "\Ping_Information.old")
Set objWorkbook = objExcel.ActiveWorkbook
objWorkbook.SaveAs(strFolder & "\Ping_Information.xls")
objExcel.Quit
Else
End If
penTextFile(
