Help with Ping VB Script

**mc134** · May 13, 2006

I am pretty new to VB scripting and I have to ping over 5,000 computers and get a result outputted to a file. I thought i would write a script and actually have it working. My problem is I have the IP addresses hard-coded into the script and I need to input from a text file as a array. I am happy with outputting to a text file but i would prefer to output to a file that i can read in excel so that i can sort between responding devices and the ones that are not. My working script is here...I know it is simple but cut me some slack.

On Error Resume Next

arrTargets = Array("192.168.2.1", "192.168.2.2")

Set objFS = CreateObject("Scripting.FileSystemObject")
Set objNewFile = objFS.CreateTextFile("output.txt")
objNewFile.WriteLine "Ping Reply Information -- Date: " & Now()

For Each strTarget In arrTargets
  Set objShell = CreateObject("WScript.Shell")
  Set objExec = objShell.Exec("ping.exe -n 2 -w 1000 " & strTarget)
  strPingResults = LCase(objExec.StdOut.ReadAll)
  If InStr(strPingResults, "reply from") Then

	objNewFile.WriteLine VbCrLf & strTarget & Chr(9) & " Yes"

	Set objWMIService = GetObject("winmgmts:" _
	 & "{impersonationLevel=impersonate}!\\" & strTarget & "\root\cimv2")
	Set colCompSystems = objWMIService.ExecQuery("SELECT * FROM " & _
	 "Win32_ComputerSystem")
	For Each objCompSystem In colCompSystems
	  WScript.Echo "Host Name: " & LCase(objCompSystem.Name)
	Next
  Else
	objNewFile.WriteLine VbCrLf & strTarget & Chr(9) & " No"	
End If
Next
objNewFile.Close
Set objShell = Wscript.CreateObject("Wscript.Shell")
objShell.Run "output.txt"

My "input" text file would be something like "list.txt" and just have each IP address listed on a seperate line.

Thank you for your help.

**gunsmokingman** · May 14, 2006

Here is a VBS script that uses WMI to ping computers, just make a list of ip and another loop for the script to run threw. I have only tested this on my computer as i do not have a network to test it on. This was tested on XP and I do not know if it works on other Windows versions.

strComputer = "."
  Dim i, IpRpt, ObjIp, StrIP
Set objWMIService = GetObject( "winmgmts:\\" & strComputer & "\root\cimv2")
'/-> PINGS THE LOCAL COMPUTER TO GET THE ADDRESS
Set colPings = objWMIService.ExecQuery("Select * From Win32_PingStatus where Address = '127.0.0.1'")
'/-> COMMENT OUT THE ABOVE LINE AS AND UNCOMMENT THE 3 LINES BELOW FOR A NETWORK COLLECTION
 '' Dim NetComp : NetComp = Array(PLACE_IP_HERE,PLACE_IP_HERE,PLACE_IP_HERE)
 '' For Each strNetComp In NetComp 
 '' Set colPings = objWMIService.ExecQuery("Select * From Win32_PingStatus where Address = '" & NetComp &  "'")
'/-> COMMENT OUT THE BELOW LINE IF USING FOR A NETWORK COLLECTION
   For Each objStatus in colPings
	If IsNull(objStatus.StatusCode)  or objStatus.StatusCode<>0 Then 
	 WScript.Echo "Computer did not respond." 
	 ''  TEXT OUTPUT HERE
	Else
'/-> START THE COLLECTION FOR IP ADDRESS AND COMPUTER NAMES
   Set ObjIp = objWMIService.ExecQuery("Select IPAddress from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
   Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
   Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem",,48) 
	For Each objItem in colItems
	 For Each StrIP in ObjIp
	  If Not IsNull(StrIP.IPAddress) Then 
	   For i=LBound(StrIP.IPAddress) To UBound(StrIP.IPAddress)
		Wscript.Echo "Computer responded."
		Wscript.Echo "Computer Ip   : " & StrIP.IPAddress(i)
		Wscript.Echo "Computer Name : " &  objItem.Caption
	   '' TEXT OUTPUT HERE
	   Next
	  End If
	 Next
	Next
'/-> END THE STARTING COLLECTION BELOW HERE
   End If
  Next

**gunsmokingman** · May 14, 2006

I made the VBS script make a HTA and I have it run threw a array like you would need to on a network, I used 127.0.01 three times as the array.

strComputer = "."
'/-> ARRAY FOR COMPUTERS IP
   Dim NetComp : NetComp = Array("127.0.0.1","127.0.0.1","127.0.0.1")
'/-> VARIBLES 
   Dim colItem, colPing, i, IpRpt, ObjIp, StrIP
   Set objWMIService = GetObject( "winmgmts:\\" & strComputer & "\root\cimv2")
	For Each strNetComp In NetComp 
	Set colPings = objWMIService.ExecQuery("Select * From Win32_PingStatus where Address = '" & strNetComp & "'")
	For Each objStatus in colPings
	If IsNull(objStatus.StatusCode)  or objStatus.StatusCode<>0 Then 
	 IpRpt = IpRpt & "<Table Border='1' width='550'>" &_
	 vbCrLf &"<TD Class='Style1'>Computer did not respond.</TD></Table>" 
	Else
'/-> START THE COLLECTION FOR IP ADDRESS AND COMPUTER NAMES
   Set ObjIp = objWMIService.ExecQuery("Select IPAddress from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
   Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
   Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem",,48) 
	For Each objItem in colItems
	 For Each StrIP in ObjIp
	  If Not IsNull(StrIP.IPAddress) Then 
	   For i=LBound(StrIP.IPAddress) To UBound(StrIP.IPAddress)
		IpRpt = IpRpt & "<Table Border='1' width='550'>" &_
		 vbCrLf &"<TD Class='Style1'>Computer responded.</TD><BR>" &_
		 vbCrLf &"<TD Class='Style1'>Computer Ip<BR>" & StrIP.IPAddress(i) & "</TD><BR>" &_
		 vbCrLf &"<TD Class='Style1'>Computer Name<BR>" &  objItem.Caption & "</TD>" &_
		 "</Table>"
	   Next
	  End If
	 Next
	Next
'/-> END THE STARTING COLLECTION BELOW HERE
   End If
  Next
 Next 
'/-> OBJECTS TO MAKE THE HTA  
  Dim Act, BodyStyle, Dtop, Fso, Hta, Td1, Ts
   BodyStyle = "Body.Normal {font:8.25pt;font-family:Arial;color:#000080;background-color:#ed0926;filter:" & vbcrlf &_
   "progid:DXImageTransform.Microsoft.Gradient(GradientType=0,StartColorStr='#eeeeee',endColorStr='#9E9E9E');" & vbcrlf &_
   "padding-top:1;padding-bottom:1;Text-Align:Center;Valign:Top;} " 
   Td1 = "td.Style1{font:8.75pt;font-family:Palatino Linotype;color:#000080;filter:progid:DXImageTransform.Microsoft.Gradient" &_
   vbcrlf & "(GradientType=0,StartColorStr='#d0d0d0',EndColorStr='#eeeeee');padding-top:1;padding-bottom:1;Text-Align:Center;}"
  Set Act = CreateObject("Wscript.Shell")
  Set Fso = CreateObject("Scripting.FileSystemObject")
  Dtop = Act.SpecialFolders("Desktop")
  Hta = Dtop & "\PingComputers.hta"
  Set Ts = Fso.CreateTextFile(Hta)
  Ts.WriteLine "<Title> Network Ping Demo </Title>"
  Ts.WriteLine "<HTA:APPLICATION Icon=""%SystemRoot%\explorer.exe"">"
  Ts.WriteLine "<Style>" & vbCrLf & BodyStyle & vbCrLf & Td1 & vbcrlf & "</Style>"
  Ts.WriteLine "<script language=javascript> window.resizeTo (625,691), window.moveTo (250,75); </SCRIPT>"
  Ts.WriteLine "<Body Class='Normal'>"
  Ts.WriteLine IpRpt
  Ts.Close 
  Act.Run(Chr(34) & Hta & Chr(34))

I have attached the VBS script in a rar file for you.

Edited August 5, 2006 by gunsmokingman

**mc134** · May 20, 2006

gunsmokingman,

Thank you for the help....I couldn't stand the wait any longer and just ran with it. Here is my finished (Is it ever really finished?) script. It worked perfectly and maybe someone can use it for themselves.

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

My first program and I'm pretty proud of it. I'm sure it could have been done better but I gotta learn somehow

Edited May 20, 2006 by mc134

**gunsmokingman** · May 20, 2006

You do not need to make this Object Five time, as they are the same

set WshShell = CreateObject("WScript.Shell")
Set objShell = CreateObject("Wscript.Shell")
Set objShell = CreateObject("WScript.Shell")
set WshShell = CreateObject("WScript.Shell")
set WshShell = CreateObject("WScript.Shell")

Use the Dim and make it once

Dim WshShell
set WshShell = CreateObject("WScript.Shell")

If you place this at the top of the script then you need it only once

On Error Resume Next

I would change this

WshShell.Run "taskkill /F /IM excel.exe"
To this to hide the Cmd Promt window if ran
WshShell.Run ("taskkill /F /IM excel.exe"), 0, True

I change this

WScript.Echo "Input text file " & strInputFile & " not found."
To this so it will close in 61 seconds
 WshShell.Popup "Input text file " & strInputFile & " not found.", 61, "Error No Text File", 0 + 48

Your code with the changes I have listed

'************************************************
'**										
'**				  Ping Script					 
'**										
'**				Michael Carpenter					  
'**										 
'**				  May 15,2006				  
'**										
'**										 
'*************************************************

On Error Resume Next

Dim WshShell : 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

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.

Const FOR_READING = 1

Set objFSO = CreateObject(Scripting.FileSystemObject)
If Not objFSO.FileExists(strInputFile) Then

  WshShell.Run( "taskkill /F /IM excel.exe"), 0 ,True 
  WshShell.Popup "Input text file " & strInputFile & " not found.", 61, "Error No Text File", 0 + 48
  WScript.Quit

End If

Set objTextStream = objFSO.OpenTextFile(strInputFile, FOR_READING)
If objTextStream.AtEndOfStream Then

  WshShell.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

'******************************************************************************

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 objExec = WshShell.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

	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

Edited May 20, 2006 by gunsmokingman

**mc134** · May 20, 2006

wow, your fast...I just copied your fixed version and ran it and now it just opens up excel and then says that the script completed. I went through it and didn't pick anything out of the ordinary. You missed one line also:

WshShell.Run("taskkill /F /IM excel.exe"), 0 ,True
  WScript.Echo "Input text file " & strInputFile & " is empty."
  WScript.Quit

I fixed it though and i really appreciate the help.

Edited May 20, 2006 by mc134

**gunsmokingman** · May 21, 2006

Thanks, glad I was able to help. Sorry I completly missed that I just look at it quickly and must of missed that.

**mc134** · May 21, 2006

You miss understood me. The new script doesn't work now. Create a text file called list.txt and add your IP address to it and then run it. My script runs and adds the information to the excel spreadsheet but yours does not. I looked through it but nothing stood out. Probably just one little typo. Thanks one again.

**gunsmokingman** · May 21, 2006

I didnt touch any of the excel stuff. I only change what I listed.

Try to Dim all the objects also as this is a good practice.

There may be more objects to dim but you can add them this is just a example.

Dim objFSO, objFile, objTextStream, objExcel, objRange, strFolder, strInputFile

I notice that you have two of these, If you Dim the Object you only need One.

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFSO = CreateObject(Scripting.FileSystemObject)

Also move the Const to the top of the script just below the On Error Resume Next

On Error Resume Next
Const FOR_READING = 1

To find out where the script is failing comment out the On Error Resume Next and see where

it fails as the script runs.

**mc134** · May 21, 2006

Thank you for helping a nooby to programming. I will try your suggestions and report back.

**gunsmokingman** · May 21, 2006

I will try my best to help you to get it working.

I think I see where you are getting a error

You have 2 of these but one only has quotes around it.

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFSO = CreateObject(Scripting.FileSystemObject)

Edited May 21, 2006 by gunsmokingman

Sign In

Help with Ping VB Script

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Create an account or sign in to comment

Create an account

Sign in

Recently Browsing 0 members