Hello
I work for a company that has staff in India who print to networked printers in UK.
The way it worked is they print to a local workstation which is configured to route to an ip address of a printer in the UK.
There is presently 13 printers set up to receive prints.
What I'd like to do is set up a VB Script to ping the workstations and our printers to see if they are online. Then write the results to an excel spreadsheet.
I'd like to spread sheet to have 3 collumns:
Alias (i.e. INDIA 1), IP Address/Hostname (V011-V02010V.banking.uk), Result of ping (reply received/not received)
Would someone have a script they've designed to implement the above?
Many thanks,
Tom
Full Version: VBScript - Ping multiple ip addresses and machine names
It's funny you'd ask for this, as I posted it today in another thread 
This does exactly what you asked, but I don't think it provides the results you asked for specifically. Also, it creates a .csv file, but that can easily be opened in excel for easy viewing. You can obviously edit it for your needs.
Anyway, here you go:
Create a file named servers.txt in the same folder as this script, with one computername/ip address that you'd like to ping per line. That should be all you need
This does exactly what you asked, but I don't think it provides the results you asked for specifically. Also, it creates a .csv file, but that can easily be opened in excel for easy viewing. You can obviously edit it for your needs.Anyway, here you go:
CODE
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
If not objFSO.FileExists("servers.txt") THEN
wscript.echo "Please create a file named 'servers.txt' with one PC name to be pinged per line,"&_
vbcrlf&"with a hard return at the end of each line."
wscript.quit
end if
tempobj="temp.txt"
Set objTextFile = objFSO.OpenTextFile("servers.txt", ForReading)
logfile="results.csv"
Set ofile=objFSO.CreateTextFile(logfile,True)
strText = objTextFile.ReadAll
objTextFile.Close
wscript.echo "Ping batch starting, please be patient. This could take some time to"&_
vbcrlf&"finish, depending on the number of hosts to check. You "_
&"will be "&vbcrlf&"notified upon the completion of this script."
ofile.WriteLine ","&"Ping Report -- Date: " & Now() & vbCrLf
arrComputers = Split(strText, vbCrLF)
for each item in arrcomputers
objShell.Run "cmd /c ping -n 1 -w 1000 " & item & " >temp.txt", 0, True
Set tempfile = objFSO.OpenTextFile(tempobj,ForReading)
Do Until tempfile.AtEndOfStream
temp=tempfile.readall
striploc = InStr(temp,"[")
If striploc=0 Then
strip=""
Else
strip=Mid(temp,striploc,16)
strip=Replace(strip,"[","")
strip=Replace(strip,"]","")
strip=Replace(strip,"w"," ")
strip=Replace(strip," ","")
End If
If InStr(temp, "Reply from") Then
ofile.writeline item & ","&strip&","&"Online."
ElseIf InStr(temp, "Request timed out.") Then
ofile.writeline item &","&strip&","&"No response (Offline)."
ELSEIf InStr(temp, "try again") Then
ofile.writeline item & ","&strip&","&"Unknown host (no DNS entry)."
End If
Loop
Next
tempfile.close
objfso.deletefile(tempobj)
ofile.writeline
ofile.writeline ","&"Ping batch complete "&now()
wscript.echo "Ping batch completed. The results will now be displayed."
objShell.Run("""C:\Program Files\Microsoft Office\OFFICE11\excel.exe """&logfile)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
If not objFSO.FileExists("servers.txt") THEN
wscript.echo "Please create a file named 'servers.txt' with one PC name to be pinged per line,"&_
vbcrlf&"with a hard return at the end of each line."
wscript.quit
end if
tempobj="temp.txt"
Set objTextFile = objFSO.OpenTextFile("servers.txt", ForReading)
logfile="results.csv"
Set ofile=objFSO.CreateTextFile(logfile,True)
strText = objTextFile.ReadAll
objTextFile.Close
wscript.echo "Ping batch starting, please be patient. This could take some time to"&_
vbcrlf&"finish, depending on the number of hosts to check. You "_
&"will be "&vbcrlf&"notified upon the completion of this script."
ofile.WriteLine ","&"Ping Report -- Date: " & Now() & vbCrLf
arrComputers = Split(strText, vbCrLF)
for each item in arrcomputers
objShell.Run "cmd /c ping -n 1 -w 1000 " & item & " >temp.txt", 0, True
Set tempfile = objFSO.OpenTextFile(tempobj,ForReading)
Do Until tempfile.AtEndOfStream
temp=tempfile.readall
striploc = InStr(temp,"[")
If striploc=0 Then
strip=""
Else
strip=Mid(temp,striploc,16)
strip=Replace(strip,"[","")
strip=Replace(strip,"]","")
strip=Replace(strip,"w"," ")
strip=Replace(strip," ","")
End If
If InStr(temp, "Reply from") Then
ofile.writeline item & ","&strip&","&"Online."
ElseIf InStr(temp, "Request timed out.") Then
ofile.writeline item &","&strip&","&"No response (Offline)."
ELSEIf InStr(temp, "try again") Then
ofile.writeline item & ","&strip&","&"Unknown host (no DNS entry)."
End If
Loop
Next
tempfile.close
objfso.deletefile(tempobj)
ofile.writeline
ofile.writeline ","&"Ping batch complete "&now()
wscript.echo "Ping batch completed. The results will now be displayed."
objShell.Run("""C:\Program Files\Microsoft Office\OFFICE11\excel.exe """&logfile)
Create a file named servers.txt in the same folder as this script, with one computername/ip address that you'd like to ping per line. That should be all you need
hello, im a complete noob but i was googling for this exact thing and was very happy when i saw your code, the problem is when i try to run it my computer gives me this error
script: C:\ping\ping.vbs
line: 13
char: 1
error: Permission denied
Code: 800A0046
Source: Microsoft VBScript runtime Error
I was running in adminstrator.
i know this is thread necromancy but i couldnt find anywere else to ask about it.
script: C:\ping\ping.vbs
line: 13
char: 1
error: Permission denied
Code: 800A0046
Source: Microsoft VBScript runtime Error
I was running in adminstrator.
i know this is thread necromancy but i couldnt find anywere else to ask about it.
The script is working fine here for me, I'd guess that you have a copy/paste error.
You could try downloading this prettied version of it if you're still having difficulty!
You could try downloading this prettied version of it if you're still having difficulty!
QUOTE (Yzöwl @ Jul 21 2008, 10:46 AM) 
I'd guess that you have a copy/paste error.
Seeing the actual error message, probably not. He gets a "Permission denied" error on a line that uses the CreateTextFile method of FSO. Odds are either:
-there's already a file with such a name, and it has the read-only attribute set (happens a lot when you copy stuff from a CD...)
or
-he doesn't have sufficient permissions to create or overwrite that file (ACLs)
But anyways, personally, I either use the Win32_PingStatus WMI class because you can get more detailed infos, more detailed error codes, and that there's no text parsing involved (doesn't work with pre-XP OS'es admittedly) , or even just plain old nmap e.g. "nmap -iL servers.txt -SP"
I'm receiving a similar error as well. I downlaoded the ping.zp. I placed the ping.vbs in a folder on my desktop. I put the servers.txt file with the machine names in the same folder as well. I received error:
Windows Host Script
Script: C:\Documents and Settings\tburns\Desktop\ping\ping.vbs
Line: 16
Char: 1
Error: Permission denied
Code: 800A0046
Source: Microsoft VBScript runtime error
I feel that I followed the instructions properly, but can someone let me know what might have happened here? I am logged in with adminstrator privileges on Windows XP Pro.
Windows Host Script
Script: C:\Documents and Settings\tburns\Desktop\ping\ping.vbs
Line: 16
Char: 1
Error: Permission denied
Code: 800A0046
Source: Microsoft VBScript runtime error
I feel that I followed the instructions properly, but can someone let me know what might have happened here? I am logged in with adminstrator privileges on Windows XP Pro.
Try this script to see if it errors
QUOTE
CODE
Option Explicit
Const ForReading = 1, ForWrite = 2, ForAppend = 8
Dim Act :Set Act = CreateObject("Wscript.Shell")
Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
Dim i, strText, Ts
If Fso.FileExists(Fso.GetParentFolderName(WScript.ScriptFullName) & "\servers.txt") Then
Set Ts = Fso.OpenTextFile("servers.txt", ForReading)
strText = Ts.ReadAll
Ts.Close
'-> Loop To Process The Ping For Each Line In Server Text
For Each i In Split(strText,vbCrLf)
Act.Run "cmd /c ping -n 1 -w 1000 " & i & " >>temp.txt", 0, True
Next
'-> Collect The Ping Results
Set Ts = Fso.OpenTextFile("temp.txt", ForReading)
strText = Ts.ReadAll
Ts.Close
'-> Loop Threw the Results
Dim R1, Results1,Results2
For Each i In Split(strText,vbCrLf)
If InStr(i,"Pinging") Then
R1 = Split(i," ")
End If
'-> Filter Out The Results
If InStr(i,"Reply from") Then
Results1 = Results1 & " Confirm Connection: " & R1(1) & vbCrLf
ElseIf InStr(i,"Request timed out") Then
Results2 = Results2 & " Missing Connection: " & R1(1) & vbCrLf
End If
Next
'-> Delete The Temp File
If Fso.FileExists(Fso.GetParentFolderName(WScript.ScriptFullName) & "\temp.txt") Then
Fso.DeleteFile(Fso.GetParentFolderName(WScript.ScriptFullName) & "\temp.txt"), True
End If
Set Ts = Fso.CreateTextFile(Fso.GetParentFolderName(WScript.ScriptFullName) & "\results.csv")
Ts.WriteLine "Ping From Server.txt Results" & vbCrLf & " Date And Time : " & Now
Ts.WriteLine Results1
Ts.WriteLine Results2
Ts.Close()
Else
MsgBox vbTab & "Error" & vbcrlf &_
"Missing, the server.txt to process. You" & vbCrLf & _
"must create a servers.txt with an IP or" & vbCrLf & _
"Computer Name, with one per line",4128,"Error"
End If
Const ForReading = 1, ForWrite = 2, ForAppend = 8
Dim Act :Set Act = CreateObject("Wscript.Shell")
Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
Dim i, strText, Ts
If Fso.FileExists(Fso.GetParentFolderName(WScript.ScriptFullName) & "\servers.txt") Then
Set Ts = Fso.OpenTextFile("servers.txt", ForReading)
strText = Ts.ReadAll
Ts.Close
'-> Loop To Process The Ping For Each Line In Server Text
For Each i In Split(strText,vbCrLf)
Act.Run "cmd /c ping -n 1 -w 1000 " & i & " >>temp.txt", 0, True
Next
'-> Collect The Ping Results
Set Ts = Fso.OpenTextFile("temp.txt", ForReading)
strText = Ts.ReadAll
Ts.Close
'-> Loop Threw the Results
Dim R1, Results1,Results2
For Each i In Split(strText,vbCrLf)
If InStr(i,"Pinging") Then
R1 = Split(i," ")
End If
'-> Filter Out The Results
If InStr(i,"Reply from") Then
Results1 = Results1 & " Confirm Connection: " & R1(1) & vbCrLf
ElseIf InStr(i,"Request timed out") Then
Results2 = Results2 & " Missing Connection: " & R1(1) & vbCrLf
End If
Next
'-> Delete The Temp File
If Fso.FileExists(Fso.GetParentFolderName(WScript.ScriptFullName) & "\temp.txt") Then
Fso.DeleteFile(Fso.GetParentFolderName(WScript.ScriptFullName) & "\temp.txt"), True
End If
Set Ts = Fso.CreateTextFile(Fso.GetParentFolderName(WScript.ScriptFullName) & "\results.csv")
Ts.WriteLine "Ping From Server.txt Results" & vbCrLf & " Date And Time : " & Now
Ts.WriteLine Results1
Ts.WriteLine Results2
Ts.Close()
Else
MsgBox vbTab & "Error" & vbcrlf &_
"Missing, the server.txt to process. You" & vbCrLf & _
"must create a servers.txt with an IP or" & vbCrLf & _
"Computer Name, with one per line",4128,"Error"
End If
The script could be cleaned up quite a bit by using Regexp to parse the Ping output instead. (See MSDN)
QUOTE (jcarle @ Mar 7 2009, 10:58 PM)
The script could be cleaned up quite a bit by using Regexp to parse the Ping output instead.
Or then again you could use the Win32_PingStatus WMI class and skip the parsing altogether (and get more detailed information along with it). Or the System.Net.NetworkInformation.Ping object if you use Powershell (again, no parsing)
This script is for XP and up only
QUOTE
CODE
Option Explicit
Const ForReading = 1, ForWrite = 2, ForAppend = 8
' Oblects And Varibles
Dim Act :Set Act = CreateObject("Wscript.Shell")
Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
Dim Wmi :Set Wmi = GetObject("winmgmts:\\.\root\cimv2")
Dim i, Obj, strText, Results1,Results2, Ts
'-> Check For Servers.txt
If Fso.FileExists(Fso.GetParentFolderName(WScript.ScriptFullName) & "\servers.txt") Then
'-> Process The Text File With The Server Information
Set Ts = Fso.OpenTextFile("servers.txt", ForReading)
strText = Ts.ReadAll
Ts.Close
'-> Loop One Process The Servers.txt
For Each i In Split(strText, vbCrLf)
'-> Loop To Ping Each Server From Servers Text
For Each Obj in Wmi.ExecQuery("Select * From Win32_PingStatus where Address = '" & i & "'")
If IsNull(Obj.StatusCode) Or Obj.StatusCode <> 0 Then
Results2 = Results2 & " Computer Off Line : " & i & vbCrLf
Else
Results1 = Results1 & " Computer On Line : " & i & vbCrLf
End If
Next
Next
'-> Create The Results Text File
Set Ts = Fso.CreateTextFile("results.txt")
Ts.WriteLine "Ping From Server.txt Results" & vbCrLf & " Date And Time : " & Now & Vbcrlf
Ts.WriteLine Results1
Ts.WriteLine Results2
Ts.Close()
Act.Run("notepad.exe " & Chr(34) & "results.txt" & Chr(34)),1,True
Else
MsgBox vbTab & "Error" & vbcrlf &_
"Missing, the server.txt to process. You" & vbCrLf & _
"must create a servers.txt with an IP or" & vbCrLf & _
"Computer Name, with one per line",4128,"Error"
End If
Const ForReading = 1, ForWrite = 2, ForAppend = 8
' Oblects And Varibles
Dim Act :Set Act = CreateObject("Wscript.Shell")
Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
Dim Wmi :Set Wmi = GetObject("winmgmts:\\.\root\cimv2")
Dim i, Obj, strText, Results1,Results2, Ts
'-> Check For Servers.txt
If Fso.FileExists(Fso.GetParentFolderName(WScript.ScriptFullName) & "\servers.txt") Then
'-> Process The Text File With The Server Information
Set Ts = Fso.OpenTextFile("servers.txt", ForReading)
strText = Ts.ReadAll
Ts.Close
'-> Loop One Process The Servers.txt
For Each i In Split(strText, vbCrLf)
'-> Loop To Ping Each Server From Servers Text
For Each Obj in Wmi.ExecQuery("Select * From Win32_PingStatus where Address = '" & i & "'")
If IsNull(Obj.StatusCode) Or Obj.StatusCode <> 0 Then
Results2 = Results2 & " Computer Off Line : " & i & vbCrLf
Else
Results1 = Results1 & " Computer On Line : " & i & vbCrLf
End If
Next
Next
'-> Create The Results Text File
Set Ts = Fso.CreateTextFile("results.txt")
Ts.WriteLine "Ping From Server.txt Results" & vbCrLf & " Date And Time : " & Now & Vbcrlf
Ts.WriteLine Results1
Ts.WriteLine Results2
Ts.Close()
Act.Run("notepad.exe " & Chr(34) & "results.txt" & Chr(34)),1,True
Else
MsgBox vbTab & "Error" & vbcrlf &_
"Missing, the server.txt to process. You" & vbCrLf & _
"must create a servers.txt with an IP or" & vbCrLf & _
"Computer Name, with one per line",4128,"Error"
End If
Here is a function I use to add some detail to ping results. You can easily add it to any of the previously posted scripts.
CODE
strPingStatus = PingStatus(strComputer)
If strPingStatus = "Success" Then '<-- Attempt to ping target system
' <do some work>
Else
' <dont do the work>
end if
wscript.quit
'--[ Functions & SubRoutines ]---------------------------------------------------
Function PingStatus(strComputer)
On Error Resume Next
strWorkstation = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strWorkstation & "\root\cimv2")
Set colPings = objWMIService.ExecQuery _
("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")
For Each objPing in colPings
Select Case objPing.StatusCode
Case 0 PingStatus = "Success"
Case 11001 PingStatus = "Status code 11001 - Buffer Too Small"
Case 11002 PingStatus = "Status code 11002 - Destination Net Unreachable"
Case 11003 PingStatus = "Status code 11003 - Destination Host Unreachable"
Case 11004 PingStatus = "Status code 11004 - Destination Protocol Unreachable"
Case 11005 PingStatus = "Status code 11005 - Destination Port Unreachable"
Case 11006 PingStatus = "Status code 11006 - No Resources"
Case 11007 PingStatus = "Status code 11007 - Bad Option"
Case 11008 PingStatus = "Status code 11008 - Hardware Error"
Case 11009 PingStatus = "Status code 11009 - Packet Too Big"
Case 11010 PingStatus = "Status code 11010 - Request Timed Out"
Case 11011 PingStatus = "Status code 11011 - Bad Request"
Case 11012 PingStatus = "Status code 11012 - Bad Route"
Case 11013 PingStatus = "Status code 11013 - TimeToLive Expired Transit"
Case 11014 PingStatus = "Status code 11014 - TimeToLive Expired Reassembly"
Case 11015 PingStatus = "Status code 11015 - Parameter Problem"
Case 11016 PingStatus = "Status code 11016 - Source Quench"
Case 11017 PingStatus = "Status code 11017 - Option Too Big"
Case 11018 PingStatus = "Status code 11018 - Bad Destination"
Case 11032 PingStatus = "Status code 11032 - Negotiating IPSEC"
Case 11050 PingStatus = "Status code 11050 - General Failure"
Case Else PingStatus = "Status code " & objPing.StatusCode & " - Unable to determine cause of failure."
End Select
Next
End Function
If strPingStatus = "Success" Then '<-- Attempt to ping target system
' <do some work>
Else
' <dont do the work>
end if
wscript.quit
'--[ Functions & SubRoutines ]---------------------------------------------------
Function PingStatus(strComputer)
On Error Resume Next
strWorkstation = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strWorkstation & "\root\cimv2")
Set colPings = objWMIService.ExecQuery _
("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")
For Each objPing in colPings
Select Case objPing.StatusCode
Case 0 PingStatus = "Success"
Case 11001 PingStatus = "Status code 11001 - Buffer Too Small"
Case 11002 PingStatus = "Status code 11002 - Destination Net Unreachable"
Case 11003 PingStatus = "Status code 11003 - Destination Host Unreachable"
Case 11004 PingStatus = "Status code 11004 - Destination Protocol Unreachable"
Case 11005 PingStatus = "Status code 11005 - Destination Port Unreachable"
Case 11006 PingStatus = "Status code 11006 - No Resources"
Case 11007 PingStatus = "Status code 11007 - Bad Option"
Case 11008 PingStatus = "Status code 11008 - Hardware Error"
Case 11009 PingStatus = "Status code 11009 - Packet Too Big"
Case 11010 PingStatus = "Status code 11010 - Request Timed Out"
Case 11011 PingStatus = "Status code 11011 - Bad Request"
Case 11012 PingStatus = "Status code 11012 - Bad Route"
Case 11013 PingStatus = "Status code 11013 - TimeToLive Expired Transit"
Case 11014 PingStatus = "Status code 11014 - TimeToLive Expired Reassembly"
Case 11015 PingStatus = "Status code 11015 - Parameter Problem"
Case 11016 PingStatus = "Status code 11016 - Source Quench"
Case 11017 PingStatus = "Status code 11017 - Option Too Big"
Case 11018 PingStatus = "Status code 11018 - Bad Destination"
Case 11032 PingStatus = "Status code 11032 - Negotiating IPSEC"
Case 11050 PingStatus = "Status code 11050 - General Failure"
Case Else PingStatus = "Status code " & objPing.StatusCode & " - Unable to determine cause of failure."
End Select
Next
End Function
This is a "lo-fi" version of our main content. To view the full version with more information, formatting and images, please click here.