tlancaster Posted September 21, 2007 Posted September 21, 2007 HelloI 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
kasandoro Posted November 12, 2007 Posted November 12, 2007 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:Const ForReading = 1Set objFSO = CreateObject("Scripting.FileSystemObject")Set objShell = CreateObject("WScript.Shell")If not objFSO.FileExists("servers.txt") THENwscript.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.quitend iftempobj="temp.txt"Set objTextFile = objFSO.OpenTextFile("servers.txt", ForReading)logfile="results.csv"Set ofile=objFSO.CreateTextFile(logfile,True)strText = objTextFile.ReadAllobjTextFile.Closewscript.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() & vbCrLfarrComputers = Split(strText, vbCrLF)for each item in arrcomputersobjShell.Run "cmd /c ping -n 1 -w 1000 " & item & " >temp.txt", 0, TrueSet 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 LoopNexttempfile.closeobjfso.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
timmio Posted July 21, 2008 Posted July 21, 2008 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.vbsline: 13char: 1error: Permission deniedCode: 800A0046Source: Microsoft VBScript runtime ErrorI was running in adminstrator.i know this is thread necromancy but i couldnt find anywere else to ask about it.
Yzöwl Posted July 21, 2008 Posted July 21, 2008 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!ping.zip
CoffeeFiend Posted July 21, 2008 Posted July 21, 2008 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"
tateburns Posted March 6, 2009 Posted March 6, 2009 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 ScriptScript: C:\Documents and Settings\tburns\Desktop\ping\ping.vbsLine: 16Char: 1Error: Permission deniedCode: 800A0046Source: Microsoft VBScript runtime errorI 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.
gunsmokingman Posted March 6, 2009 Posted March 6, 2009 Try this script to see if it errorsOption ExplicitConst 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
jcarle Posted March 8, 2009 Posted March 8, 2009 The script could be cleaned up quite a bit by using Regexp to parse the Ping output instead. (See MSDN)
CoffeeFiend Posted March 8, 2009 Posted March 8, 2009 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)
gunsmokingman Posted March 8, 2009 Posted March 8, 2009 This script is for XP and up onlyOption 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
kcmjr Posted June 9, 2009 Posted June 9, 2009 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.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 NextEnd Function
jkumhar Posted September 9, 2010 Posted September 9, 2010 (edited) How we can make this script to echo the ping the result after pinging the each server?Because if it;s getting stuck in between..it's taking time and wait for the final CSV log file.Please let me know ASAP. Edited September 9, 2010 by jkumhar
gunsmokingman Posted September 9, 2010 Posted September 9, 2010 How we can make this script to echo the ping the result after pinging the each server?Because if it;s getting stuck in between..it's taking time and wait for the final CSV log file.Please let me know ASAP.Here is the part of the script, where the pinging results are. Edit this area 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
gunsmokingman Posted April 6, 2011 Posted April 6, 2011 I got this errorWhich of the above script is causing the problems?
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now