'Scheduling program. Launches programs, scripts, and 
'batch files according to schedule entered in matching 
'database. It will create the matching database (if 
'needed) the first time it runs. Multiple instances 
'of the script are blocked, but a side-effect of the 
'blocking method is that you must wait 30+ seconds to 
're-start the script after you stop it.
'Note: Database Month value is STRING, for example, 
'use July, not 7. In all cases with numbers, DO NOT use 
'leading zeros. You can use comma-delimited sets. For
'example, for a script that runs at 7AM and 5PM on 
'weekdays, set the "Weekday" value to:
'Monday,Tuesday,Wednesday,Thursday,Friday
'... and set the "Hour" value to:
'7,17

Option Explicit

Main

Sub Main()
Dim fs 'As Scripting.FileSystemObject
Dim wsh 'As Wscript.Shell
Dim dbeng 'As DAO.DBEngine
Dim db 'As Database
Dim rs 'As Recordset
Dim strTest 'As String
Dim dtLastCheck 'As Date
Const dbOpenDynaset = 2 'DAO.RecordsetTypeEnum
Const dbReadOnly = 4 'DAO.RecordsetOptionEnum
Const dbOpenSnapshot = 4 'DAO.RecordsetTypeEnum
Const dbOptimistic = 3 'DAO.LockTypeEnum
	'Create objects
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set wsh = CreateObject("Wscript.Shell")
	'First check to see if a database file exists
	If Not fs.FileExists(FileNameLikeMine("mdb")) Then
		CreateDatabase
	End If
	'Now open the database
	Set dbeng = CreateObject("DAO.DBEngine.36")
	Set db = dbeng.OpenDatabase(FileNameLikeMine("mdb"), False, False)
	'Second thing is to see if another instance is running. 
	'Do this by looking at the LastLoopTime. Things are checked
	'every 15 seconds, so a LastLoopTime of under 25 seconds implies
	'another instance is already running. Not foolproof, but...
	Set rs = db.OpenRecordset("SELECT * FROM LastCheck;", dbOpenSnapshot, , dbReadOnly)
	On Error Resume Next 'ignore possibility of null/empty values
	dtLastCheck = CDate(0) 'initialize to old value
	dtLastCheck = rs.Fields("LastLoopTime").Value
	On Error Goto 0 'Turn error checking back on
	If IsDate(dtLastCheck) Then
		If DateDiff("s", dtLastCheck, Now) < 25 Then
			'Another instance is running. Exit.
			rs.Close
			db.Close
			Exit Sub
		End If
	End If
	'We are legitimate. Log the program start.
	WriteLog Now & vbTab & WScript.ScriptFullName
	'Begin the infinite loop constantly checking the database
	Do
		'First thing is to see if we are still at the same 
		'minute value as the last time we checked. If so, 
		'don't actually launch anything!
		Set rs = db.OpenRecordset("SELECT * FROM LastCheck;", dbOpenSnapshot, , dbReadOnly)
		On Error Resume Next 'ignore possibility of null/empty values
		dtLastCheck = CDate(0) 'initialize to old value
		dtLastCheck = rs.Fields("LastCheckTime").Value
		On Error Goto 0 'Turn error checking back on
		If Minute(dtLastCheck) <> Minute(Now) Then
			'It's a new minute, okay to do something this time through the loop!
			'First update the LastCheckTime
			Set rs = db.OpenRecordset("SELECT * FROM LastCheck;", dbOpenDynaset, , dbOptimistic)
			If rs.EOF Then
				rs.AddNew
			Else
				rs.Edit
			End If
			rs.Fields("LastCheckTime") = Now
			rs.Update
			rs.Close
			'Now open the schedule and see what's there
			Set rs = db.OpenRecordset("SELECT * FROM Schedule;", dbOpenSnapshot, , dbReadOnly)
			If Not(rs.EOF And rs.BOF) Then
				Status Now & " -- checking."
				rs.MoveFirst
				'Read each record in the database
				Do until rs.EOF
					Do 'Dummy loop to make skipping easier
						On Error Resume Next 'ignore possibility of null/empty values
						
						strTest = "" 'set initial value in case of null value
						strTest = rs.Fields("Year") 'get the field
						strTest = Replace(strTest, " ", "") 'remove spaces
						If strTest <> "" Then
							strTest = "," & strTest & "," 'bracket data with commas for easy compares
							If InStr(strTest, "," & Year(Now) & ",") = 0 Then Exit Do
						End If
						
						strTest = "" 'set initial value in case of null value
						strTest = rs.Fields("Month") 'get the field
						strTest = Replace(strTest, " ", "") 'remove spaces
						If strTest <> "" Then
							strTest = "," & strTest & "," 'bracket data with commas for easy compares
							If InStr(strTest, "," & MonthName(Month(Now)) & ",") = 0 Then Exit Do
						End If
						
						strTest = "" 'set initial value in case of null value
						strTest = rs.Fields("Weekday") 'get the field
						strTest = Replace(strTest, " ", "") 'remove spaces
						If strTest <> "" Then
							strTest = "," & strTest & "," 'bracket data with commas for easy compares
							If InStr(strTest, "," & WeekDayName(Weekday(Now)) & ",") = 0 Then Exit Do
						End If
						
						strTest = "" 'set initial value in case of null value
						strTest = rs.Fields("Day") 'get the field
						strTest = Replace(strTest, " ", "") 'remove spaces
						If strTest <> "" Then
							strTest = "," & strTest & "," 'bracket data with commas for easy compares
							If InStr(strTest, "," & Day(Now) & ",") = 0 Then Exit Do
						End If
						
						strTest = "" 'set initial value in case of null value
						strTest = rs.Fields("Hour") 'get the field
						strTest = Replace(strTest, " ", "") 'remove spaces
						If strTest <> "" Then
							strTest = "," & strTest & "," 'bracket data with commas for easy compares
							If InStr(strTest, "," & Hour(Now) & ",") = 0 Then Exit Do
						End If
						
						strTest = "" 'set initial value in case of null value
						strTest = rs.Fields("Minute") 'get the field
						strTest = Replace(strTest, " ", "") 'remove spaces
						If strTest <> "" Then
							strTest = "," & strTest & "," 'bracket data with commas for easy compares
							If InStr(strTest, "," & Minute(Now) & ",") = 0 Then Exit Do
						End If
						
						'Time/Data entries pass all tests! Run it!
						WriteLog Now & vbTab & rs.Fields("Description")
						Status Now & " -- LAUNCHING: " & rs.Fields("Description")
						wsh.Run rs.Fields("CommandLine"), 0, False
						Exit Do 'Mandatory exit from dummy loop
					Loop
					rs.MoveNext
				Loop
			Else
				Status Now & " -- database is empty."
			End If
		Else
			Status Now
		End If
		rs.Close
		'Now write the LastLoopTime
		Set rs = db.OpenRecordset("SELECT * FROM LastCheck;", dbOpenDynaset, , dbOptimistic)
		If rs.EOF Then
			rs.AddNew
		Else
			rs.Edit
		End If
		rs.Fields("LastLoopTime") = Now
		rs.Update
		rs.Close
		'Sleep for 15 seconds before checking things again
		WScript.Sleep 15000
	Loop
End Sub

Sub WriteLog(strText)
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForAppending = 8
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "log", ForAppending, True)
	ts.WriteLine strText
	ts.Close
End Sub

Function FileNameLikeMine(strFileExtension) 'As String
'Returns a file name the same as the script name except
'for the file extension. 
Dim fs 'As Object
Dim strExtension 'As String
	Set fs = CreateObject("Scripting.FileSystemObject")
	strExtension = strFileExtension
	If Len(strExtension) < 1 Then strExtension = "txt"
	If strExtension = "." Then strExtension = "txt"
	If Left(strExtension,1) = "." Then strExtension = Mid(strExtension, 2)
	FileNameLikeMine = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & strExtension
End Function

Sub Status(strMessage)
	If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then
		Wscript.Echo strMessage
	End If
End Sub

Sub CreateDatabase()
'Creates a database with the same root name as the script
'but with an mdb file extension. Initializes the new database
'with a table also named after the script name.
Dim dbeng 'As DAO.Dbengine
Dim db 'As Database
Dim td 'As TableDef
Dim fld 'As Field
Dim rs 'As Recordset
Const dbDate = 8 'DAO.DataTypeEnum
Const dbText = 10 'DAO.DataTypeEnum
Const dbLangGeneral = ";LANGID=0x0409;CP=1252;COUNTRY=0" 'DAO.LanguageConstants
	Set dbeng = CreateObject("DAO.DBEngine.36")
	'Create the database mdb file
	Set db = dbeng.CreateDatabase(FileNameLikeMine("mdb"), dbLangGeneral)
	'Create the LastCheck table
	Set td = db.CreateTableDef("LastCheck")
	'Create the LastCheck fields
	td.Fields.Append td.CreateField("LastLoopTime", dbDate)
	td.Fields.Append td.CreateField("LastCheckTime", dbDate)
	db.TableDefs.Append td
	'Create the Schedule table
	Set td = db.CreateTableDef("Schedule")
	'Create the Schedule fields
	td.Fields.Append td.CreateField("Description", dbText, 255)
	td.Fields.Append td.CreateField("CommandLine", dbText, 255)
	td.Fields.Append td.CreateField("Year", dbText, 255)
	td.Fields.Append td.CreateField("Month", dbText, 255)
	td.Fields.Append td.CreateField("Date", dbText, 255)
	td.Fields.Append td.CreateField("WeekDay", dbText, 255)
	td.Fields.Append td.CreateField("Hour", dbText, 255)
	td.Fields.Append td.CreateField("Minute", dbText, 255)
	db.TableDefs.Append td
	'Clean up
	db.Close
End Sub