mc134 Posted May 13, 2006 Share Posted 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 NextarrTargets = 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 IfNextobjNewFile.CloseSet 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. Link to comment Share on other sites More sharing options...
gunsmokingman Posted May 14, 2006 Share Posted 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, StrIPSet objWMIService = GetObject( "winmgmts:\\" & strComputer & "\root\cimv2")'/-> PINGS THE LOCAL COMPUTER TO GET THE ADDRESSSet 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 Link to comment Share on other sites More sharing options...
gunsmokingman Posted May 14, 2006 Share Posted May 14, 2006 (edited) 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 Link to comment Share on other sites More sharing options...
mc134 Posted May 20, 2006 Author Share Posted May 20, 2006 (edited) 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 Nextset 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 addressesSet objShell = CreateObject("Wscript.Shell")strPath = Wscript.ScriptFullNameSet 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 NextConst FOR_READING = 1Set 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.QuitEnd IfSet 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.QuitEnd IfarrLines = Split(objTextStream.ReadAll, vbCrLf)objTextStream.CloseReadTextFile = arrLinesEnd Function'******************************************************************************On Error Resume Nextx = 2'Open Excel and populate header InformationSet objExcel = CreateObject("Excel.Application")objExcel.Visible = TrueSet objWorkbook = objExcel.Workbooks.Add()Set objWorksheet = objWorkbook.Worksheets(1)objWorksheet.ActivateobjWorksheet.Name = "Ping Output"objExcel.Cells(1, 1).Value = "IP Address "objExcel.Cells(1, 1).Font.Bold = TRUEobjExcel.Cells(1, 1).Font.Size = 12objExcel.Cells(1, 1).Interior.colorIndex = 15objExcel.Cells(1, 2).Value = "Reply? "objExcel.Cells(1, 2).Font.Bold = TRUEobjExcel.Cells(1, 2).Font.Size = 12objExcel.Cells(1, 2).Interior.colorIndex = 15Set objRange = objExcel.Range("A1")objRange.ActivateSet objRange = objExcel.ActiveCell.EntireColumnobjRange.Autofit()Set objRange = objExcel.Range("B1")objRange.ActivateSet objRange = objExcel.ActiveCell.EntireColumnobjRange.Autofit()'Ping machines from list and based on reply, enter information in excelFor 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 IfNext'******************************************************************************'Make sure that excel is selectedSet 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 / NoobjRange.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 IfMy 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 Link to comment Share on other sites More sharing options...
gunsmokingman Posted May 20, 2006 Share Posted May 20, 2006 (edited) You do not need to make this Object Five time, as they are the sameset 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 onceDim WshShellset WshShell = CreateObject("WScript.Shell") If you place this at the top of the script then you need it only onceOn Error Resume Next I would change this WshShell.Run "taskkill /F /IM excel.exe"To this to hide the Cmd Promt window if ranWshShell.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 NextDim 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 addressesstrPath = Wscript.ScriptFullNameSet 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 = 1Set 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.QuitEnd IfSet 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.QuitEnd IfarrLines = Split(objTextStream.ReadAll, vbCrLf)objTextStream.CloseReadTextFile = arrLinesEnd Function'******************************************************************************x = 2'Open Excel and populate header InformationSet objExcel = CreateObject("Excel.Application")objExcel.Visible = TrueSet objWorkbook = objExcel.Workbooks.Add()Set objWorksheet = objWorkbook.Worksheets(1)objWorksheet.ActivateobjWorksheet.Name = "Ping Output"objExcel.Cells(1, 1).Value = "IP Address "objExcel.Cells(1, 1).Font.Bold = TRUEobjExcel.Cells(1, 1).Font.Size = 12objExcel.Cells(1, 1).Interior.colorIndex = 15objExcel.Cells(1, 2).Value = "Reply? "objExcel.Cells(1, 2).Font.Bold = TRUEobjExcel.Cells(1, 2).Font.Size = 12objExcel.Cells(1, 2).Interior.colorIndex = 15Set objRange = objExcel.Range("A1")objRange.ActivateSet objRange = objExcel.ActiveCell.EntireColumnobjRange.Autofit()Set objRange = objExcel.Range("B1")objRange.ActivateSet objRange = objExcel.ActiveCell.EntireColumnobjRange.Autofit()'Ping machines from list and based on reply, enter information in excelFor 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 IfNext'******************************************************************************'Make sure that excel is selectedSet 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 / NoobjRange.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 Link to comment Share on other sites More sharing options...
mc134 Posted May 20, 2006 Author Share Posted May 20, 2006 (edited) 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.QuitI fixed it though and i really appreciate the help. Edited May 20, 2006 by mc134 Link to comment Share on other sites More sharing options...
gunsmokingman Posted May 21, 2006 Share Posted 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. Link to comment Share on other sites More sharing options...
mc134 Posted May 21, 2006 Author Share Posted 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. Link to comment Share on other sites More sharing options...
gunsmokingman Posted May 21, 2006 Share Posted 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, strInputFileI 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 NextOn Error Resume NextConst FOR_READING = 1To find out where the script is failing comment out the On Error Resume Next and see where it fails as the script runs. Link to comment Share on other sites More sharing options...
mc134 Posted May 21, 2006 Author Share Posted May 21, 2006 Thank you for helping a nooby to programming. I will try your suggestions and report back. Link to comment Share on other sites More sharing options...
gunsmokingman Posted May 21, 2006 Share Posted May 21, 2006 (edited) I will try my best to help you to get it working.I think I see where you are getting a errorYou 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 Link to comment Share on other sites More sharing options...
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