vb script doesn't run completely

damoncf1234
damoncf1234 used Ask the Experts™
on
Hello,

I have a script that runs on our (2003) domain that basically attempts to ping each computer in active directory, then writes a text file that contains information such as the last logged-on username, IP address, MAC, memory, machine type, virus definition dates, etc...  It also verifies the local admin account is named appropriately and has the correct password.  It then e-mails the created .csv file to whoever we specify at the bottom of the script.  

It was running successfully daily for about a month, with a file size of about 200k.  Lately it stops running after only 8 or so computers, with a file size of about 6k.  

I'm wondering if there's some sort of error in the script that's causing it to "stop" after about 8 machines, rather than scanning the rest of the machines in the domain as it did previously.  

Any help would be appreciated.  Thanks.  
-Chris
On Error Resume Next
 
Const ADS_SCOPE_SUBTREE = 2
Const ForWriting = 2
Const ForReading = 1
Const HKEY_LOCAL_MACHINE = &H80000002
Const OpenAsDefault = -2
Const FailIfNotExist = 0
 
strDay = Day(NOW)
	If strDay < 10 Then strDay = "0" & strDay
strMonth = MonthName((Month(NOW)),True)
strYear = Year(NOW)
strDate = strDay & strMonth & strYear
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
set objShell = CreateObject("Wscript.Shell")
strScriptPath = objFSO.GetParentFolderName(wScript.ScriptFullName)
 
Set objLogFile = objFSO.CreateTextFile("Inventory_" & strDate & ".csv", ForWriting, True)
 
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingConteXt")
 
'Binds to Active Directory
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open = "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("SearchScope") = ADS_SCOPE_SUBTREE
 
objLogFile.WriteLine "MachineName	IP_Address	Vendor	Model	Service_Tag	User	Processor	Speed	MacAddress	Memory	DiskSize	Freespace	VirusDefDate"
 
'Searches for all computers in the domain
objCommand.CommandText = "SELECT Name FROM 'LDAP://" & strDNSDomain & "' WHERE objectCategory='computer'"
Set objRecordset = objCommand.Execute
 
objRecordSet.MoveFirst
 
Do Until objRecordSet.EOF
	strComputer = objRecordSet.Fields("Name").value
 
	strCommand = "%comspec% /c ping -n 3 -w 1000 " & strComputer & ""
	Set objExecObject = objShell.Exec(strCommand)
 
	Do While Not objExecObject.StdOut.AtEndOfStream
	strText = objExecObject.StdOut.ReadAll()
		If Instr(strText, "Reply") > 0 Then
		arrPingReply = Split(strText," ")
		strIP = Replace(arrPingReply(14),":","")
 
 
			'Determine Model Number, Service Tag
			Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strIP & "\root\cimv2")
			If objWMIService IS Nothing Then
			objLogFile.Writeline strComputer & vbtab & "unable_to_connect_to_WMI!"
			Else
 
				Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystemProduct")
					For Each objItem In colItems
					strModel = objItem.Name
					strVendor = objItem.Vendor
					strServiceTag = objItem.IdentifyingNumber
					Next
 
				Set colProcessors = objWMIService.ExecQuery("Select * from Win32_Processor")
					For Each objProcessor in colProcessors
					strProcessor = objProcessor.Name
					strClockSpeed = objProcessor.MaxClockSpeed
					Next
 
 
				Set colNetworkCards = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=True")
					For Each objNetworkCard In colNetworkCards
					strMacAddress = objNetworkCard.MacAddress
					Next
 
				Set colMemory = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory")
					For Each objMemory In colMemory
					strMemory = Round(objMemory.Capacity/1048576)
					Next
 
				Set colDisks = objWMIService.ExecQuery("Select * from Win32_LogicalDisk Where DriveType = '3'")
					For Each objDisk In colDisks
					strDiskSize = Round(objDisk.Size/1073741824)
					strFreeSpace = Round(objDisk.Freespace/1073741824)
					Next
 
				'Rename the local admin account and set it's password to default
				If Instr(strComputer,"-DC") = 0 Then
				Set colAccounts = objWMIService.ExecQuery("Select * From Win32_UserAccount Where LocalAccount = TRUE")
					For Each objAccount in colAccounts
						If Left (objAccount.SID, 6) = "S-1-5-" and Right(objAccount.SID, 4) = "-500" Then
					        	Set objAdmin = GetObject("WinNT://" & objAccount.Domain & "/" & objAccount.Name)
							objAdmin.SetPassword("password")
							objUser.Rename("username")
						End If
					Next
				
				'Determine last logged on user
				Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
				strKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\WinLogon"
				strValueName = "DefaultUserName"
				objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strLastLoggedOnUser
				
				Else
 
				strLastLoggedOnUser = "SysAdmin"
 
				End If
			
				If objFSO.FileExists("\\" & strIP & "\c$\Program Files\Common Files\Symantec Shared\VirusDefs\definfo.dat") Then
      					Set objFile = objFSO.OpenTextFile("\\" & strIP & "\c$\Program Files\Common Files\Symantec Shared\VirusDefs\definfo.dat", ForReading, FailIfNotExist, OpenAsDefault)
				Else
					stVirusDefDate = 0
				End If
				strResults = objFile.ReadAll
				objFile.Close
    
  				arrSplitAtCurDefs = Split(strResults, "CurDefs=")
				arrSplitAtLF = Split(arrSplitAtCurDefs(1), vbLf)
				strVirusDefDate = Replace(arrSplitAtLF(0), vbCr, "")
	
				objLogFile.WriteLine strComputer & vbtab & strIP & vbtab & strVendor & vbtab & strModel & vbtab & strServiceTag & vbtab & strLastLoggedOnUser & vbtab & strProcessor & vbtab & strClockSpeed & vbtab & strMacAddress & vbtab & strMemory & vbtab & strDiskSize & vbtab & strFreeSpace & vbtab & strVirusDefDate
		
			End If
 
		Else
		'Unable to connect to machine
		'objLogFile.WriteLine strComputer & vbtab & "not_pingable!"
		End If
	Loop
 
	objRecordSet.MoveNext
 
Set objWMIService = Nothing
strLastLoggedOnUser = "Unknown"
 
Loop
 
objLogFile.Close
 
'Now we send this csv file as an attachment to somebody that cares
Set objemail = CreateObject("CDO.Message")
objEmail.From = "user@domain.com"
objEmail.To = "user@domain.com"
objEmail.CC = "user2@domain.com"
objEmail.subject = "Inventory Report for" & strDate
objEmail.TextBody = "This email and the attached inventory file was created by a script.  It is repeatable and if something needs changed, let me know."
objEmail.AddAttachment(strScriptPath & "\Inventory_" & strDate & ".csv")
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.48.4"
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®

Commented:
Can you comment the line "On Error Resume Next" then launch the script manually ?

Author

Commented:
flob9,
I commented out the "On Error Resume Next" and launched the script as you suggested.  Long story short, a few errors came up, and I worked through them.  I got the script to work on one network fine -- all of the machines come up as expected, with all fileds populated.  Also, a black command window comes up and disappears for each workstation found in AD.  

Now the problem is that this script works perfectly on one of our networks, but on another (isolated) network, it runs until the .csv file reaches 6kb, and stops (the black command windows stop appearing as well).  We've tried running it from different machines, including the domain controllers, with the same results.  On this particular network, the script runs fine until the .csv file reaches 6 kb and then stops...  

Do you have any suggestions as to why this could be happening on one network, even though the script runs fine on another network?  I'm wondering if there's a bad computer account in AD on the second network that is causing the script to stop at the same point each time, which happens to be when the .csv file is at 6kb...?  Any ideas?  

Is there a way to modify this script to have it run in a specific OU?  Or could we specify a list of machine names to run from, instead of pulling a list from AD?  Any help would be appreciated.  

Below is the modified version of the script that works on one network, but stops after 6kb on the second.  
On Error Resume Next
 
Const ADS_SCOPE_SUBTREE = 2
Const ForWriting = 2
Const ForReading = 1
Const HKEY_LOCAL_MACHINE = &H80000002
Const OpenAsDefault = -2
Const FailIfNotExist = 0
 
strDay = Day(NOW)
	If strDay < 10 Then strDay = "0" & strDay
strMonth = MonthName((Month(NOW)),True)
strYear = Year(NOW)
strDate = strDay & strMonth & strYear
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
set objShell = CreateObject("Wscript.Shell")
strScriptPath = objFSO.GetParentFolderName(wScript.ScriptFullName)
 
Set objLogFile = objFSO.CreateTextFile("Inventory_" & strDate & ".csv", ForWriting, True)
 
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingConteXt")
 
'Binds to Active Directory
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open = "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("SearchScope") = ADS_SCOPE_SUBTREE
 
objLogFile.WriteLine "MachineName	IP_Address	Vendor	Model	Service_Tag	User	Processor	Speed	MacAddress	Memory	DiskSize	Freespace	VirusDefDate"
 
'Searches for all computers in the domain
objCommand.CommandText = "SELECT Name FROM 'LDAP://" & strDNSDomain & "' WHERE objectCategory='computer'"
Set objRecordset = objCommand.Execute
 
objRecordSet.MoveFirst
 
Do Until objRecordSet.EOF
	strComputer = objRecordSet.Fields("Name").value
 
	strCommand = "%comspec% /c ping -n 3 -w 1000 " & strComputer & ""
	Set objExecObject = objShell.Exec(strCommand)
 
	Do While Not objExecObject.StdOut.AtEndOfStream
	strText = objExecObject.StdOut.ReadAll()
		If Instr(strText, "Reply") > 0 Then
		arrPingReply = Split(strText," ")
		strIP = Replace(arrPingReply(14),":","")
 
 
			'Determine Model Number, Service Tag
			Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strIP & "\root\cimv2")
			If objWMIService IS Nothing Then
			objLogFile.Writeline strComputer & vbtab & "unable_to_connect_to_WMI!"
			Else
 
				Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystemProduct")
					For Each objItem In colItems
					strModel = objItem.Name
					strVendor = objItem.Vendor
					strServiceTag = objItem.IdentifyingNumber
					Next
 
				Set colProcessors = objWMIService.ExecQuery("Select * from Win32_Processor")
					For Each objProcessor in colProcessors
					strProcessor = objProcessor.Name
					strClockSpeed = objProcessor.MaxClockSpeed
					Next
 
 
				Set colNetworkCards = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=True")
					For Each objNetworkCard In colNetworkCards
					strMacAddress = objNetworkCard.MacAddress
					Next
 
				Set colMemory = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory")
					For Each objMemory In colMemory
					strMemory = Round(objMemory.Capacity/1048576)
					Next
 
				Set colDisks = objWMIService.ExecQuery("Select * from Win32_LogicalDisk Where DriveType = '3'")
					For Each objDisk In colDisks
					strDiskSize = Round(objDisk.Size/1073741824)
					strFreeSpace = Round(objDisk.Freespace/1073741824)
					Next
 
'Determine last logged on user
				Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
				strKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\WinLogon"
				strValueName = "DefaultUserName"
				objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strLastLoggedOnUser
				
				'Else
 
				'strLastLoggedOnUser = "SysAdmin"
 
				'End If
 
If objFSO.FileExists("\\" & strIP & "\c$\Program Files\Common Files\Symantec Shared\VirusDefs\definfo.dat") Then
      					Set objFile = objFSO.OpenTextFile("\\" & strIP & "\c$\Program Files\Common Files\Symantec Shared\VirusDefs\definfo.dat", ForReading, FailIfNotExist, OpenAsDefault)
				Else
					stVirusDefDate = 0
				End If
				strResults = objFile.ReadAll
				objFile.Close
    
  				arrSplitAtCurDefs = Split(strResults, "CurDefs=")
				arrSplitAtLF = Split(arrSplitAtCurDefs(1), vbLf)
				strVirusDefDate = Replace(arrSplitAtLF(0), vbCr, "")
	
				objLogFile.WriteLine strComputer & vbtab & strIP & vbtab & strVendor & vbtab & strModel & vbtab & strServiceTag & vbtab & strLastLoggedOnUser & vbtab & strProcessor & vbtab & strClockSpeed & vbtab & strMacAddress & vbtab & strMemory & vbtab & strDiskSize & vbtab & strFreeSpace & vbtab & strVirusDefDate
		
			End If
 
		Else
		'Unable to connect to machine
		'objLogFile.WriteLine strComputer & vbtab & "not_pingable!"
		End If
	Loop
 
	objRecordSet.MoveNext
 
Set objWMIService = Nothing
strLastLoggedOnUser = "Unknown"
 
Loop
 
objLogFile.Close

Open in new window

I reckon that the 6k thing just happens to be 6k because that is how much data has been collected before the script encounters a machine that it has a problem with.  For whatever reason this machine makes the script barf.
Can you take the On Error Resume Next out again and see what error you get.
From experience, WMI is your most likely problem but if you can get the line that is causing the exception, we can probably handle the error in a nicer way.
 
Success in ‘20 With a Profitable Pricing Strategy

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Commented:
The black window appearing must be the ping command :

strCommand = "%comspec% /c ping -n 3 -w 1000 " & strComputer & ""
      Set objExecObject = objShell.Exec(strCommand)

About the second network, are you sure there is missing computers ?

Add some debug code in the script, like this :

WScript.echo "Working on " & strComputer

(line 45)

Author

Commented:
Alan,
That's what I was thinking about the 6kb thing as well, that it must be some machine that's messing the script up, and is just a coincidence that the .csv file is always 6kb when it happens.  

Flob9,

About the second network, we're sure that there are missing computers.  There are over 1000 machines on the second network, and when the script stops the .csv file only contains about 8 machines...  

I'm at a remote site today and don't have access to the second network, but I'll take out the "on error resume next" and add the WScript.echo "Working on " & strComputer and let you know what the results are.  

Thanks.

Author

Commented:
Is there a way to run this script on a specific OU, rather all computer accounts in AD?  I'm thinking that might help isolate groups of machines, and help determine if there are "problem machines" that are causing the script to stop...  
You should be able to speciify a particluar OU, you would just need to specify the dc and ou components in the LDAP select
eg, objCommand.CommandText = "SELECT Name FROM 'LDAP://ou=sales,dc=yourdomain,dc=com WHERE objectCategory='computer'"
This link might be useful for that: http://www.microsoft.com/technet/scriptcenter/resources/qanda/apr05/hey0412.mspx
However, if all you want to know is which machine is "breaking" the script, why not just stick a wscript.echo within the loop so that each machinename is echoed to the screen?

Do Until objRecordSet.EOF
	strComputer = objRecordSet.Fields("Name").value
         wscript.echo strComputer 

Open in new window

Author

Commented:
Alan/flob9,

Thanks for the response.  I added the wscript.echo strComputer into the script, and also added the line to run the script in a specific OU.  The first 3 OUs went fine, bringing up a box with each machine name.  We're able to get the .csv file to go well above 6k now as it scans each OU individually.  Some machines are coming up as "unable to connect to WMI.  What would be causing this?  I'm running the script as a domain admin, so I should have the appropriate rights.  

Another "difference" I've seen between the script running on the first network (the one that has always worked without any issues) and the second network (the one that stops running) is the command prompt (black) windows don't popup on the 1st network, but they do on the second network...  What would cause this?  

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial