Solved

VBS Script Problems

Posted on 2009-07-07
6
373 Views
Last Modified: 2012-05-07
The following script has been created by using scripts developed by other people and then modified for my needs.  I am a scripting novice and was wondering if any could help with what is causing my error.  When run on my Windows XP workstation all works fine and produces the required output file.  However I was developing the script to run against a mixture of Win2K and Win2003 servers when run on these servers the VBScript returns a 80041017 error.
' All setup work is being done starting here
	Const adVarChar = 200
	Const MaxCharacters = 255
	Dim datein
	Dim datecre
	Dim Datemod
	Dim dateacc
	Dim filesize
	Dim fsizematch
 
	dim EMailTo		' for recipient address
	dim objMessage ' for the e-mail 
	dim sMailText  ' for the e-mail text message
 
	' E-mail address to receive script progress notifications
 
	eMailTo = "xxx.yyy@abc.com"
 
 
	Set oFSO = CreateObject("Scripting.FileSystemObject")
	Set fOut = oFSO.CreateTextFile("c:\listerms.txt", True)
	Set objEmail = CreateObject("CDO.Message")
	strComputer = "."
	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
 
	'Send a starting e-mail
	sMailText = "STARTING Lister Scan"
	SendMail
	'End of starting Email 
 
	strComputer = "."
	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
	strFolderName = "c:\hrcontrol\test"
 
' All setup work is finished by here
 
' All hard work done here
 
Set colSubfolders = objWMIService.ExecQuery _
    ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
        & "Where AssocClass = Win32_Subdirectory " _
            & "ResultRole = PartComponent")
 
 
arrFolderPath = Split(strFolderName, "\")
strNewPath = ""
For i = 1 to Ubound(arrFolderPath)
    strNewPath = strNewPath & "\\" & arrFolderPath(i)
Next
strPath = strNewPath & "\\"
 
Set colFiles = objWMIService.ExecQuery _
    ("Select * from CIM_DataFile where Path = '" & strPath & "'")
 
For Each objFile in colFiles
			datein = mid(objfile.InstallDate,5,2) & "/" & mid(objfile.InstallDate,7,2) & "/" & mid(objfile.InstallDate,1,4)
			datecre = mid(objfile.CreationDate,5,2) & "/" & mid(objfile.CreationDate,7,2) & "/" & mid(objfile.CreationDate,1,4)
			datemod = mid(objfile.LastModified,5,2) & "/" & mid(objfile.LastModified,7,2) & "/" & mid(objfile.LastModified,1,4)
			dateacc = mid(objfile.LastAccessed,5,2) & "/" & mid(objfile.LastAccessed,7,2) & "/" & mid(objfile.LastAccessed,1,4)
 
If objfile.filesize > 524288000 Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
Else
		If lcase(Right(objFile.Name,3)) = "exe" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,3)) = "mp3" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,3)) = "wma" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,3)) = "com" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,3)) = "zip" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,3)) = "msi" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,3)) = "scr" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,3)) = "avi" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,4)) = "mpeg" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		End if
End if
Next
 
For Each objFolder in colSubfolders
    GetSubFolders strFolderName
Next
 
Sub GetSubFolders(strFolderName)
    Set colSubfolders2 = objWMIService.ExecQuery _
        ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
            & "Where AssocClass = Win32_Subdirectory " _
                & "ResultRole = PartComponent")
 
    For Each objFolder2 in colSubfolders2
        strFolderName = objFolder2.Name
'        Wscript.Echo
'        Wscript.Echo objFolder2.Name
        arrFolderPath = Split(strFolderName, "\")
        strNewPath = ""
        For i = 1 to Ubound(arrFolderPath)
            strNewPath = strNewPath & "\\" & arrFolderPath(i)
        Next
        strPath = strNewPath & "\\"
 
        Set colFiles = objWMIService.ExecQuery _
            ("Select * from CIM_DataFile where Path = '" & strPath & "'")
 
        For Each objFile in colFiles
			datein = mid(objfile.InstallDate,5,2) & "/" & mid(objfile.InstallDate,7,2) & "/" & mid(objfile.InstallDate,1,4)
			datecre = mid(objfile.CreationDate,5,2) & "/" & mid(objfile.CreationDate,7,2) & "/" & mid(objfile.CreationDate,1,4)
			datemod = mid(objfile.LastModified,5,2) & "/" & mid(objfile.LastModified,7,2) & "/" & mid(objfile.LastModified,1,4)
			dateacc = mid(objfile.LastAccessed,5,2) & "/" & mid(objfile.LastAccessed,7,2) & "/" & mid(objfile.LastAccessed,1,4)
 
'If count = 0 Then
'    MsgBox "There are no items."
'ElseIf count = 1 Then
'    MsgBox "There is 1 item."
'Else
'    MsgBox "There are " & count & " items."
'End If
 
 
 
If objfile.filesize > 524288000 Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
Else
		If lcase(Right(objFile.Name,3)) = "exe" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,3)) = "mp3" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,3)) = "wma" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,3)) = "com" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,3)) = "zip" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,3)) = "msi" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,3)) = "scr" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,3)) = "avi" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		ElseIf	lcase(Right(objFile.Name,4)) = "mpeg" Then
			fOut.WriteLine objFile.Name & "," & objfile.filesize & "," & datecre & "," & datein & "," & datemod & "," & dateacc & ","
		End If
End If
 
		Next
        GetSubFolders strFolderName
    Next
End Sub
 
Sub SendMail
	Set objMessage = CreateObject("CDO.Message") 
	objMessage.Subject = sMailText
 
	objMessage.From = "lister@abc.com" 
	objMessage.To = eMailTo 
	objMessage.Configuration.Fields.Item _
	("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
	objMessage.Configuration.Fields.Item _
	("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp"
	objMessage.Configuration.Fields.Item _
	("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
	objMessage.Configuration.Fields.Update
 
	objMessage.Send
	Set objMessage = Nothing
End Sub
 
' All finishing work is being done starting here
 
 
 
	'Send a finishing e-mail
	sMailText = "FINISHED Lister Scan"
	SendMail
	'End of starting Email

Open in new window

0
Comment
Question by:HoricePlant
  • 3
  • 2
6 Comments
 
LVL 33

Expert Comment

by:Todd Gerbert
ID: 24794953
What line number is it failing on?  The error should give this to you...
0
 

Author Comment

by:HoricePlant
ID: 24795007
The error is as per the attached
eexch.doc
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 24800033
Hi, this would indicate to me that no files have been returned from the search.  Above this line:
        Set colFiles = objWMIService.ExecQuery _
            ("Select * from CIM_DataFile where Path = '" & strPath & "'")

if you put this

MsgBox "Getting file collection from " & strPath

You will then see the folder path that the script will read.  Verify that that path exists on your target system.

Regards,

Rob.
0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 

Author Comment

by:HoricePlant
ID: 24802599
RobSampson thanks for the comment and yes it appears partially to be correct that nothing is being returned.  

However it would appear that the issue is more based on the fact that some of the returned data contains special characters like apostrophes.  This therefore causes issues with the data retruned being incomplete.  Does anyone have any idea how to get round this.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 24802744
Hmmm, but you've posted that the error is on this line
        For Each objFile in colFiles

Which suggests that no files are returned by the query
        Set colFiles = objWMIService.ExecQuery _
            ("Select * from CIM_DataFile where Path = '" & strPath & "'")

If that *is* because the folder path contains apostrophes, then you can try the following:
        Set colFiles = objWMIService.ExecQuery _
            ("Select * from CIM_DataFile where Path = '" & Replace(strPath, "'", "\'") & "'")

which replaces any apostrophes in strPath with \' to try to escape that character.

Regards,

Rob.
0
 

Author Closing Comment

by:HoricePlant
ID: 31600631
I had further work to do to complete the answer.
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This is pretty cool.  The purpose of this VB Script is to help you document where JAR (Java ARchive) files and specifically java class files are located so that you can address issues seen with a client or that you can speak intelligently with a dev…
Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28455246.html)28455246) Here (http…
Two types of users will appreciate AOMEI Backupper Pro: 1 - Those with PCIe drives (and haven't found cloning software that works on them). 2 - Those who want a fast clone of their boot drive (no re-boots needed) and it can clone your drive wh…
The Email Laundry PDF encryption service allows companies to send confidential encrypted  emails to anybody. The PDF document can also contain attachments that are embedded in the encrypted PDF. The password is randomly generated by The Email Laundr…

789 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question