• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2500
  • Last Modified:

VBScript won't run as Scheduled Task

I've got a simple VB script that opens up an Excel Spreadsheet, checks for dates in a single column, then fires off an email.  I put it as a scheduled task and try to right click and manually run and it never runs.  No errors, just sits on "Running" for status and doesn't stop until I end it.

Double clicking this VBScript kicks everything off just fine.
0
Brad Bouchard
Asked:
Brad Bouchard
  • 14
  • 12
1 Solution
 
KimputerCommented:
Do you run it under another user? Are there prompts to click away?
0
 
Brad BouchardInformation Systems Security OfficerAuthor Commented:
Do you run it under another user? Are there prompts to click away?
No prompts to click away.  I just tried as an experiment running it with the setting "Run only when logged in as this user."

Which I am currently logged in as and it works fine.  Switch it to the other option and it won't work.

task
0
 
RobSampsonCommented:
Excel is an application that can only be run when a user is logged in.  Without that option, it will not work.  There is another scripting method you may be able to use when no one is logged in, which uses the Microsoft.ACE.OLEDB.12.0 provider.
http://www.robvanderwoude.com/sourcecode.php?src=excelrd_vbs

The above example is probably a bit overcompicated, but if you'd like me to have a go at converting your current code, I can give it a shot.

Rob.
0
Creating Active Directory Users from a Text File

If your organization has a need to mass-create AD user accounts, watch this video to see how its done without the need for scripting or other unnecessary complexities.

 
Brad BouchardInformation Systems Security OfficerAuthor Commented:
Ha, Rob my VB savior, I was hoping you'd chime in on this.  I'd love for you to have a go at converting my code (since you basically wrote it for me; thanks again) as I can't leave a user logged in to the server where I want the scheduled task to run.  It will have to be run like the link above.

Here is my code again:

Dim objExcel
Dim objOutlook
Dim objMail
Dim objWB
Dim objWS
Dim vCell
Dim wsIndex, bodyText, blnServersFound, arrDateParts, dtePurchaseDate
Dim strServer, strTo, strFrom, strSubject

strServer = "SMTP.SERVER.COM"
strTo = "user@domain.com"
strFrom = "user@domain.com"
strSubject = "End-of-Life Servers"
strUsername = "user"
strPassword = "password"

Const xlUp = -4162
 
Set objExcel = CreateObject("Excel.Application")
 
objExcel.DisplayAlerts = False
objExcel.Visible = True
objExcel.Workbooks.Open ("\\Server\Folder\File.xlsx")
Set objWB = objExcel.ActiveWorkbook
bodyText = "The following servers have reached, or are nearing, their 4 year replacement:" & vbNewLine & vbNewLine
blnServersFound = False
For wsIndex = 1 To objWB.Sheets.Count
    Set objWS = objWB.Worksheets(wsIndex)
    For Each vCell In objWS.Range("J2:J" & objWS.Cells(objWS.Rows.Count, "J").End(xlUp).Row).Cells
       	arrDateParts = Split(vCell, "/")
       	If UBound(arrDateParts) = 2 Then
            dtePurchaseDate = FormatDateTime(arrDateParts(1) & "/" & MonthName(arrDateParts(0), True) & "/" & arrDateParts(2))
			If Date >= DateAdd("yyyy", 4, FormatDateTime(dtePurchaseDate)) Then
				bodyText = bodyText & "Server " & objWS.Cells(vCell.Row, "B").Value & " (" & objWS.Cells(vCell.Row, "G").Value & " - " &_
					objWS.Cells(vCell.Row, "H").Value & ") has reached its end of life.  It was purchased on " & dtePurchaseDate & vbNewLine & vbNewLine
				blnServersFound = True
			End If
		End If
    Next
Next

If blnServersFound = True Then
	SendEmail strServer, strTo, strFrom, strSubject, bodyText, "", strUsername, strPassword
End If
 
objWB.Save
objWB.Close
objExcel.Quit
 
Set objExcel = Nothing
Set objWB = Nothing
Set objWS = Nothing

Sub SendEmail(strServer, strTo, strFrom, strSubject, strBody, strAttachment, strUser, strPass)
        Dim objMessage
        
        Set objMessage = CreateObject("CDO.Message")
        objMessage.To = strTo
        objMessage.From = strFrom
        objMessage.Subject = strSubject
        objMessage.TextBody = strBody
  		If strAttachment <> "" Then objMessage.AddAttachment strAttachment
  		
        '==This section provides the configuration information for the remote SMTP server.
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        'Name or IP of Remote SMTP Server
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strServer
        'Server port (typically 25)
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUser
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strPass
        objMessage.Configuration.Fields.Update
        '==End remote SMTP server configuration section==
 
        objMessage.Send
        Set objMessage = Nothing
End Sub

Open in new window

0
 
RobSampsonCommented:
OK, here is my version of it....seems to work pretty well (haven't tested the emailing, but it should be fine).

The only downfall from this version is that you must manually specify the sheet names in the script, using the arrSheets array.  Once you do that, it will grab the Purchased date from each sheet, and check the date.

Regards,

Rob.

strFile = "C:\Temp\Scripts\ServerInventory.xlsx"
arrSheets = Array("Production", "Recovery", "Virtual")

strServer = "SMTP.SERVER.COM"
strTo = "user@domain.com"
strFrom = "user@domain.com"
strSubject = "End-of-Life Servers"
strUsername = "user"
strPassword = "password"

bodyText = "The following servers have reached, or are nearing, their 4 year replacement:" & vbNewLine & vbNewLine
blnServersFound = False

Const adOpenStatic = 3
Set objExcel = CreateObject("ADODB.Connection")
' With IMEX=1 numbers won't be ignored; tip by Thomas Willig.
' Connection string updated by Marcel Niënkemper to open Excel 2007 (.xslx) files.
objExcel.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile & ";Extended Properties=""Excel 12.0;IMEX=1;HDR=YES;"""
' Open a recordset object for the sheet and range
For Each strSheet In arrSheets
	Set objRS = CreateObject( "ADODB.Recordset" )
	objRS.Open "Select * from [" & strSheet & "$]", objExcel, adOpenStatic
	Do Until objRS.EOF
		' Stop reading when an empty row is encountered in the Excel sheet
		If IsNull(objRS.Fields(0).Value) Or Trim(objRS.Fields(0).Value) = "" Then Exit Do
       	arrDateParts = Split(objRS("Purchased"), "/")
       	If UBound(arrDateParts) = 2 Then
            dtePurchaseDate = FormatDateTime(arrDateParts(1) & "/" & MonthName(arrDateParts(0), True) & "/" & arrDateParts(2))
			If Date >= DateAdd("yyyy", 4, FormatDateTime(dtePurchaseDate)) Then
				bodyText = bodyText & "Server " & objRS("Name") & " (" & objRS("Model") & " - " &_
					objRS("Server Type") & ") has reached its end of life.  It was purchased on " & dtePurchaseDate & vbNewLine & vbNewLine
				blnServersFound = True
			End If
		End If
		objRS.MoveNext
	Loop
 
	' Close the file and release the objects
	objRS.Close
Next

objExcel.Close
Set objRS    = Nothing
Set objExcel = Nothing

If blnServersFound = True Then
	SendEmail strServer, strTo, strFrom, strSubject, bodyText, "", strUsername, strPassword
End If

Sub SendEmail(strServer, strTo, strFrom, strSubject, strBody, strAttachment, strUser, strPass)
        Dim objMessage
        
        Set objMessage = CreateObject("CDO.Message")
        objMessage.To = strTo
        objMessage.From = strFrom
        objMessage.Subject = strSubject
        objMessage.TextBody = strBody
  		If strAttachment <> "" Then objMessage.AddAttachment strAttachment
  		
        '==This section provides the configuration information for the remote SMTP server.
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        'Name or IP of Remote SMTP Server
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strServer
        'Server port (typically 25)
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUser
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strPass
        objMessage.Configuration.Fields.Update
        '==End remote SMTP server configuration section==
 
        objMessage.Send
        Set objMessage = Nothing
End Sub

Open in new window

0
 
Brad BouchardInformation Systems Security OfficerAuthor Commented:
The only downfall from this version is that you must manually specify the sheet names in the script, using the arrSheets array.
If that's the worst I have to put up with then I think I'm doing good.  I'll test it out and let you know.  Thanks Rob.
0
 
Brad BouchardInformation Systems Security OfficerAuthor Commented:
There is another scripting method you may be able to use when no one is logged in, which uses the Microsoft.ACE.OLEDB.12.0 provider.
How do I install/configure this?  I got an error when trying to run the script that referenced line 18, which is this Microsoft.ACE.OLEDB.12.0.

I'm sure it's easy, just don't know what I need to install/configure or if there is an assembly that needs added or registered?

Thanks Rob.
0
 
Brad BouchardInformation Systems Security OfficerAuthor Commented:
Line 18:
objExcel.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile & ";Extended Properties=""Excel 12.0;IMEX=1;HDR=YES;"""

Open in new window


Error:ProviderCannotBeFound
0
 
RobSampsonCommented:
If you're using a 64 bit system, can you try running
C:\windows\SysWoW64\cscript.exe C:\Scripts\TestScript.vbs
From an elevated command prompt?
0
 
Brad BouchardInformation Systems Security OfficerAuthor Commented:
Tried both System32 and SysWoW64 from an elevated prompt... here are the results:

C:\Windows\system32>C:\windows\SysWoW64\cscript.exe E:\Scripts\EOLServersAlert.v
bs
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation. All rights reserved.

E:\Scripts\EOLServersAlert.vbs(26, 9) Microsoft VBScript runtime error: Invalid
use of Null: 'Split'


C:\Windows\system32>C:\windows\System32\cscript.exe E:\Scripts\EOLServersAlert.v
bs
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation. All rights reserved.

E:\Scripts\EOLServersAlert.vbs(18, 1) ADODB.Connection: Provider cannot be found
. It may not be properly installed.





And sorry, I should clarify, that I just tried to double click on this one to get it to run, I didn't try setting it as a task yet.
0
 
RobSampsonCommented:
Ok, so the 32 bit cscript finds the provider, good.  For the Split error do you have a column that has Purchased as the header? I can add a Null check if we need to.

Rob.
0
 
Brad BouchardInformation Systems Security OfficerAuthor Commented:
Ok, so the 32 bit cscript finds the provider, good.

Actually to clarify, the 64bit gets the split error, and the 32bit doesn't find the provider.

Column J has a header of "Purchased" ... without quotes...
0
 
RobSampsonCommented:
On a 64 bit system, 64 bit files are in the System32 folder and 32 bit binaries are in the SysWow64 folder. WoW is Windows-on-Windows. So by running CScript from the SysWow64 folder, you'll find in Task Manager that it runs in the 32 bit process.

I'll add a Null check when I get in to work. Is the date still separated by the forward slash?

Rob.
0
 
Brad BouchardInformation Systems Security OfficerAuthor Commented:
On a 64 bit system, 64 bit files are in the System32 folder and 32 bit binaries are in the SysWow64 folder. WoW is Windows-on-Windows.
I knew the 64 bit files were in the system32 but I didn't know 32 bit were in SysWoW.  Thanks.

Yes the date is still separated by the forward slash.
0
 
RobSampsonCommented:
Looking at the code again, change line 25 from this:
		If IsNull(objRS.Fields(0).Value) Or Trim(objRS.Fields(0).Value) = "" Then Exit Do

Open in new window


to this:
		If IsNull(objRS.Fields("Purchased")) Or Trim(objRS.Fields("Purchased")) = "" Then Exit Do

Open in new window


and that should do it.....

Rob.
0
 
Brad BouchardInformation Systems Security OfficerAuthor Commented:
Rob,

I've made the changes suggested above, however if I try to manually double click on the file and run it I still get the error mentioned earlier.  I also tried to set it as a scheduled task and it says that it runs but it never does anything.  I also tried going to Command Prompt and running this:

C:\Windows\system32>cscript "e:\scripts\EOLServersAlert.vbs"
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation. All rights reserved.

e:\scripts\EOLServersAlert.vbs(18, 1) ADODB.Connection: Provider cannot be found
. It may not be properly installed.


Any ideas?
0
 
RobSampsonCommented:
You need to run the CScript from the SysWow64 folder, since manually double-clicking it doesn't run that version.  From an elevated command prompt, run
C:\windows\SysWoW64\cscript.exe E:\Scripts\EOLServersAlert.v
bs

When setting up the schedule task, make sure it runs that version, and set the Run with Highest Privileges tick box.

Rob.
0
 
Brad BouchardInformation Systems Security OfficerAuthor Commented:
C:\Windows\system32>C:\windows\SysWoW64\cscript.exe E:\Scripts\EOLServersAlert.v
bs
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation. All rights reserved.

E:\Scripts\EOLServersAlert.vbs(30, 5) ADODB.Recordset: Item cannot be found in t
he collection corresponding to the requested name or ordinal.
0
 
RobSampsonCommented:
Line 30 is looking for columns called Name, Model, and Server Type in the sheet. Make sure there are columns with those exact names, or change the text that is to be inserted into the email body.

Rob.
0
 
Brad BouchardInformation Systems Security OfficerAuthor Commented:
Got it, I changed "Model" to "ProLiant Model".  That's now been corrected, however it will only return the first EOL server from the 2nd tab on the worksheet.  I ran it and it did find the first one on the TestDev tab, but then didn't find any others.

Ideas?
0
 
RobSampsonCommented:
Do you have any empty values in the first column? The code exits the loop when it hit an empty value. Probably should change that to just skip the current record, or check a different column, but I can't do that until tomorrow.....sorry.

You could try just commenting out that Exit Do line and see what you get....
Rob.
0
 
Brad BouchardInformation Systems Security OfficerAuthor Commented:
You could try just commenting out that Exit Do line and see what you get....
I'll do this today and see if it works.  If it works I'll report back and let you know and we can be done.  If it doesn't, and you do have the time tomorrow to edit that section, that would be excellent.  I'll keep you posted.
0
 
Brad BouchardInformation Systems Security OfficerAuthor Commented:
I commented it out and got this...

C:\Windows\system32>C:\windows\SysWoW64\cscript.exe E:\Scripts\EOLServersAlert.v
bs
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation. All rights reserved.

E:\Scripts\EOLServersAlert.vbs(26, 9) Microsoft VBScript runtime error: Invalid
use of Null: 'Split'


So, if you don't mind, and I can wait until tomorrow, I'd appreciate it if you could change it for me.  Thanks for your help and patience my friend.
0
 
RobSampsonCommented:
No problem. I'm on a plane right now, I'll post back tomorrow.
0
 
RobSampsonCommented:
Hi, I'm back.

Can you try this version?

Rob.

strFile = "C:\Temp\Scripts\ServerInventory.xlsx"
arrSheets = Array("Production", "Recovery", "Virtual")

strServer = "SMTP.SERVER.COM"
strTo = "user@domain.com"
strFrom = "user@domain.com"
strSubject = "End-of-Life Servers"
strUsername = "user"
strPassword = "password"

bodyText = "The following servers have reached, or are nearing, their 4 year replacement:" & vbNewLine & vbNewLine
blnServersFound = False

Const adOpenStatic = 3
Set objExcel = CreateObject("ADODB.Connection")
' With IMEX=1 numbers won't be ignored; tip by Thomas Willig.
' Connection string updated by Marcel Niënkemper to open Excel 2007 (.xslx) files.
objExcel.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile & ";Extended Properties=""Excel 12.0;IMEX=1;HDR=YES;"""
' Open a recordset object for the sheet and range
For Each strSheet In arrSheets
	Set objRS = CreateObject( "ADODB.Recordset" )
	objRS.Open "Select * from [" & strSheet & "$]", objExcel, adOpenStatic
	Do Until objRS.EOF
		' Stop reading when an empty row is encountered in the Excel sheet
		If IsNull(objRS.Fields("Purchased")) Or Trim(objRS.Fields("Purchased")) = "" Then
			' Skip rows without purchase dates
		Else
	       	arrDateParts = Split(objRS("Purchased"), "/")
	       	If UBound(arrDateParts) = 2 Then
	            dtePurchaseDate = FormatDateTime(arrDateParts(1) & "/" & MonthName(arrDateParts(0), True) & "/" & arrDateParts(2))
				If Date >= DateAdd("yyyy", 4, FormatDateTime(dtePurchaseDate)) Then
					bodyText = bodyText & "Server " & objRS("Name") & " (" & objRS("ProLiant Model") & " - " &_
						objRS("Server Type") & ") has reached its end of life.  It was purchased on " & dtePurchaseDate & vbNewLine & vbNewLine
					blnServersFound = True
				End If
			End If
		End If
		objRS.MoveNext
	Loop
 
	' Close the file and release the objects
	objRS.Close
Next

objExcel.Close
Set objRS    = Nothing
Set objExcel = Nothing

If blnServersFound = True Then
	SendEmail strServer, strTo, strFrom, strSubject, bodyText, "", strUsername, strPassword
End If

Sub SendEmail(strServer, strTo, strFrom, strSubject, strBody, strAttachment, strUser, strPass)
        Dim objMessage
        
        Set objMessage = CreateObject("CDO.Message")
        objMessage.To = strTo
        objMessage.From = strFrom
        objMessage.Subject = strSubject
        objMessage.TextBody = strBody
  		If strAttachment <> "" Then objMessage.AddAttachment strAttachment
  		
        '==This section provides the configuration information for the remote SMTP server.
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        'Name or IP of Remote SMTP Server
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strServer
        'Server port (typically 25)
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUser
        objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strPass
        objMessage.Configuration.Fields.Update
        '==End remote SMTP server configuration section==
 
        objMessage.Send
        Set objMessage = Nothing
End Sub

Open in new window

0
 
Brad BouchardInformation Systems Security OfficerAuthor Commented:
Chalk another one up for the smartest VB man I know.  Thanks again Rob, your patience was truly remarkable.  This is why I love EE; Experts helping experts.
0
 
RobSampsonCommented:
Great! Thanks for the grade. Thank you for your patience as well. It's always difficult when we're on opposite sides of the globe to provide a timely solution.

Let me know if there's anything else I can help you with.

Rob.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Simplify Active Directory Administration

Administration of Active Directory does not have to be hard.  Too often what should be a simple task is made more difficult than it needs to be.The solution?  Hyena from SystemTools Software.  With ease-of-use as well as powerful importing and bulk updating capabilities.

  • 14
  • 12
Tackle projects and never again get stuck behind a technical roadblock.
Join Now