VBS Special Date Tracker
Introduction
Every month there are Birthdays, Anniversaries and Special Dates for special people or events in your life. Sometimes it is hard to keep track of them all from year to year. You may store them on a note card file deck (i.e. Rolodex), transfer them from year to year on your hanging calendar or pocket event planner; you may even have an app that stores Birthdays, Anniversaries or Special Dates i.e. the Olympics, Opening Day, Camping Trip, the next instructable contest.
If you are not using a digital date tracker then you may want to review this and create your own VBS Special Date Tracker. If you are using a digital date tracker and it is only OK, but you are looking for something else that may do more or is easier to use. Let’s look at what this application can do for you.
1) Digitally stores all the Birthdays, Anniversaries or Special Dates of special people or events in your life. – No more writing and rewriting the dates from month to month and year to year. No more searching a paper list.
2) At a quick glance you know what day of the week the Birthdays, Anniversaries or Special Dates are on for the month you choose. Plus I added a visual calendar of the month.
3) At a quick glance you know how many years old or what anniversary you are celebrating or commemorating on the Birthdays, Anniversaries or Special Dates. – You no longer have to calculate the years.
4) Displays a chronological list of the Birthdays, Anniversaries or Special Dates.
5) Simply add the Date and Name of the Birthday, Anniversary or Special Date. The database will keep track of the Day of the Week and Number of Years.
6) Allows you to easily delete a Birthday, Anniversary or Special Date that is no longer needed to track. – Simply choose the month you want to view and then type part or all of the Date or Name of the birthday, anniversary or special date.
This small file keeps track of and does a lot for you. Wouldn't you like to have an app like that? Wait, wouldn't you like to create an app like that? You can customize your own VBS Special Date Tracker or use it as it stands.
The Story
If you read my VBS Date Calculator App, Systematic Buzz Phrase Generator.vbs or VBS Holiday Countdown instructables then this is the next step in creating more dynamic VBS applications. The last 2 were simple predefined databases. This application allows you to easily create a more sophisticated database, one where you update and modify (write to a file) the data to meet your needs, search the data based upon certain predefined criteria and then view the results in a easy to read format.
I wanted to create an application to be something simple to use, something with easy to understand code and not a resource hog. After some trial and error this is what I came up with, read on to create your own VBS Special Date Tracker.
Every month there are Birthdays, Anniversaries and Special Dates for special people or events in your life. Sometimes it is hard to keep track of them all from year to year. You may store them on a note card file deck (i.e. Rolodex), transfer them from year to year on your hanging calendar or pocket event planner; you may even have an app that stores Birthdays, Anniversaries or Special Dates i.e. the Olympics, Opening Day, Camping Trip, the next instructable contest.
If you are not using a digital date tracker then you may want to review this and create your own VBS Special Date Tracker. If you are using a digital date tracker and it is only OK, but you are looking for something else that may do more or is easier to use. Let’s look at what this application can do for you.
1) Digitally stores all the Birthdays, Anniversaries or Special Dates of special people or events in your life. – No more writing and rewriting the dates from month to month and year to year. No more searching a paper list.
2) At a quick glance you know what day of the week the Birthdays, Anniversaries or Special Dates are on for the month you choose. Plus I added a visual calendar of the month.
3) At a quick glance you know how many years old or what anniversary you are celebrating or commemorating on the Birthdays, Anniversaries or Special Dates. – You no longer have to calculate the years.
4) Displays a chronological list of the Birthdays, Anniversaries or Special Dates.
5) Simply add the Date and Name of the Birthday, Anniversary or Special Date. The database will keep track of the Day of the Week and Number of Years.
6) Allows you to easily delete a Birthday, Anniversary or Special Date that is no longer needed to track. – Simply choose the month you want to view and then type part or all of the Date or Name of the birthday, anniversary or special date.
This small file keeps track of and does a lot for you. Wouldn't you like to have an app like that? Wait, wouldn't you like to create an app like that? You can customize your own VBS Special Date Tracker or use it as it stands.
The Story
If you read my VBS Date Calculator App, Systematic Buzz Phrase Generator.vbs or VBS Holiday Countdown instructables then this is the next step in creating more dynamic VBS applications. The last 2 were simple predefined databases. This application allows you to easily create a more sophisticated database, one where you update and modify (write to a file) the data to meet your needs, search the data based upon certain predefined criteria and then view the results in a easy to read format.
I wanted to create an application to be something simple to use, something with easy to understand code and not a resource hog. After some trial and error this is what I came up with, read on to create your own VBS Special Date Tracker.
Highlevel Overview
Outline of this instructable:
Step 1 – Introduce new Items not seen in my other VBS apps.
1) Declare a constant for Reading, Writing, Appending a file.
2) Check if file exists, create new one if it does not.
3) Searching the file to match criteria.
Steps 2 – 5 give you an explanation on How To use the finished VBS Special Date Tracker;
Steps 6 – 7 give you the code and How To save the file and
Step 8 my Observations and Summary.
Step 1 – Introduce new Items not seen in my other VBS apps.
1) Declare a constant for Reading, Writing, Appending a file.
2) Check if file exists, create new one if it does not.
3) Searching the file to match criteria.
Steps 2 – 5 give you an explanation on How To use the finished VBS Special Date Tracker;
Steps 6 – 7 give you the code and How To save the file and
Step 8 my Observations and Summary.
Option #1
View Special Dates for the Current month.
After you type "1" in the input box and click "OK" then you will see all the special dates for the current month sorted in numerical order along with any US Federal holidays and Special holidays.
Notice that the day of the week and how many years are also displayed. Those are calculated in the back ground. Any date that has a year will display a count of the number of years such as the age of someone or anniversary with the exception of a date with the current year such as a holiday.
After you type "1" in the input box and click "OK" then you will see all the special dates for the current month sorted in numerical order along with any US Federal holidays and Special holidays.
Notice that the day of the week and how many years are also displayed. Those are calculated in the back ground. Any date that has a year will display a count of the number of years such as the age of someone or anniversary with the exception of a date with the current year such as a holiday.
Option #2
View special dates for Next month.
After you type "2" in the input box and click "OK" then you will see all the special dates for the next month sorted in numerical order along with any US Federal holidays and Special holidays.
Notice that the day of the week and how many years are also displayed. Those are calculated in the back ground. Any date that has a year will display a count of the number of years such as the age of someone or anniversary with the exception of a date with the current year such as a holiday.
After you type "2" in the input box and click "OK" then you will see all the special dates for the next month sorted in numerical order along with any US Federal holidays and Special holidays.
Notice that the day of the week and how many years are also displayed. Those are calculated in the back ground. Any date that has a year will display a count of the number of years such as the age of someone or anniversary with the exception of a date with the current year such as a holiday.
Option #3
Add a Date and Name to your List.
After you type "3" in the input box and click "OK" then
You will prompted to type in the Month/Day/Year and the name of the special day. Type in the Date and Name and then Click "OK".
After you have entered the special day you will receive a confirmation message that the special day was entered.
You do not have to type the day of the week or how many years. Those are calculated in the back ground.
After you type "3" in the input box and click "OK" then
You will prompted to type in the Month/Day/Year and the name of the special day. Type in the Date and Name and then Click "OK".
After you have entered the special day you will receive a confirmation message that the special day was entered.
You do not have to type the day of the week or how many years. Those are calculated in the back ground.
Option #4
Remove a Date and Name from your List.
After you type "4" in the input box and click "OK" then you will be prompted for the month you would like to view.
Type in the month number you would like and click "OK".
If you have any dates in the month you chose then you will see the list Numerical / Alpha order, otherwise you will receive a messages saying there are no date for the month.
Then Type the Date, Name or Both to be removed. The Date and Name are Case Sensitive. Be specific. The less you type the more will be matched and deleted. If you typed a couple of letters or numbers then any data in that month that has what you typed in will be deleted.
Holidays can not be deleted unless you add them via Option #3.
After you type "4" in the input box and click "OK" then you will be prompted for the month you would like to view.
Type in the month number you would like and click "OK".
If you have any dates in the month you chose then you will see the list Numerical / Alpha order, otherwise you will receive a messages saying there are no date for the month.
Then Type the Date, Name or Both to be removed. The Date and Name are Case Sensitive. Be specific. The less you type the more will be matched and deleted. If you typed a couple of letters or numbers then any data in that month that has what you typed in will be deleted.
Holidays can not be deleted unless you add them via Option #3.
The Code
1) Open the Notepad application:
Click Start => click Programs => click Accessories => click Notepad
Or
Click Start => Click Run => Type Notepad in the Run input box then Click OK.
2) Copy the code below the Apostrophe and Asterisks line then Paste it into Notepad.
' *********************************************
Dim Notice
Dim Message
Dim fso
Dim objFile
Dim arrLines
Dim arrList
Dim FileName
Dim Hol(12)
Set fso = CreateObject("Scripting.FileSystemObject")
FileName = "c:\MySpecialDates.txt"
Const ForReading = 1
Const ForWriting = 2 'will over write everything
Const ForAppending = 8 'will create or append file
' this code will create the Data file
If (fso.FileExists(FileName))= False Then
set objFile = FSO.OpenTextFile(FileName, ForAppending, True)
objFile.Close
End if
' Error Handling
On Error Resume Next
' Standard Inputbox
Notice = " My Special Dates - Today is " & WeekDayNAme(WeekDay(Date)) & " " & Date
Message = "What would you like to do ?" & vbcr & vbcr &_
"1 - View Dates for This month " & vbcr &_
"2 - View Dates for Next month " & vbcr &_
"3 - Add a Date and Name to your List " & vbCr &_
"4 - Remove a Date and Name from your List" & vbcr & vbcr &_
"Enter the number of your choice."
' InputBox results
Question = InputBox(message,Notice)
' Check for Null or empty inputbox then cancels
IF IsEmpty(Question) THEN
WScript.quit()
ELSEIF Len(Question) = 0 THEN
WScript.quit()
ELSEIF Question = 0 THEN
WScript.quit()
ELSE
SELECT Case Question
Case 1 Run(1)
Case 2 Run(2)
Case 3 Run(3)
Case 4 Run(4)
END SELECT
END IF
' Case Statements for result
Sub Run(var)
Set WS = CreateObject("WScript.shell")
' January
' This checks if current month is Dec to decide which holiday date to use
IF Month(date) = "12" then
Hol(0)="01/01/"& Right(DateSerial(Year(Date)+1,1,1),4) & " New Year's Day"
Hol(1) = "0"& DateSerial(Year(Date)+1,1,22) - Weekday(DateSerial(Year(Date)+1,1,22),3) & " MLK Day"
ELSE
Hol(0)="01/01/"&Right(DateSerial(Year(Date),1,1),4) & " New Year's Day"
Hol(1) = "0"& DateSerial(Year(Date),1,22) - Weekday(DateSerial(Year(Date),1,22),3) & " MLK Day"
END IF
' February
Hol(2) = "02/14/"&Year(Date) & " Valentine's Day"
Hol(3) = "0"&DateSerial(Year(Date),3,1) - Weekday(DateSerial(Year(Date),3,1),3) - 7 &" President's Day"
' May
Hol(4) = "0" &DateSerial(Year(Date),6,1) - Weekday(DateSerial(Year(Date),6,1),3) & " Memorial Day"
' July
Hol(5) = "07/04/" & Year(Date) & " Independence Day"
' September
Hol(6) = "09/0"&Mid(DateSerial(Year(Date),9,8) - Weekday(DateSerial(Year(Date),9,8),3),3,1)&"/" & Year(Date)& " Labor Day"
' October
Hol(7) = DateSerial(Year(Date),10,15) - Weekday(DateSerial(Year(Date),10,15),3) & " Columbus Day"
' November
Hol(8) = DateSerial(Year(Date),11,11) & " Veterans' Day"
Hol(9) = DateSerial(Year(Date),11,29) - Weekday(DateSerial(Year(Date),11,29),6) &" Thanksgiving Day"
' December
Hol(10) = DateSerial(Year(Date),12,25) & " Christmas Day"
Hol(11)= DateSerial(Year(Date),12,31) & " New Year's Eve"
Select Case var
Case 1 ' View Current Month
Set objRegEx = CreateObject("VBScript.RegExp")
DateSearch = Right(String(2,"0") & Month(Date), 2)
objRegEx.Pattern = "^" & DateSearch
Set objFile = fso.OpenTextFile(FileName, ForReading)
Set arrLines = CreateObject("System.Collections.ArrayList")
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
IF colMatches.Count > 0 Then
For Each strMatch in colMatches
arrLines.Add(strSearchString)
Next
END IF
Loop
' Filter, Add & sort Holidays for calendar month
For i=0 to 11
Set colMatches = objRegEx.Execute(hol(i))
IF colMatches.Count > 0 Then
For Each strMatch in colMatches
arrLines.Add(hol(i))
arrLines.sort()
Next
END IF
Next
' Write all special dates to new file so day of week can be added
Dim TempFile
tempfile= "c:\Dates.txt"
set objFile = FSO.OpenTextFile(TempFile, ForAppending, True)
objFile.Close
'Join the array with Line feed
Dim strNewFile : strNewFile = Join(arrLines.ToArray, vbCrLf)
'Re-open the file for reading
Set objFile = fso.OpenTextFile(TempFile, ForWriting, False)
'Write the new text
objFile.Write strNewFile
objFile.Close
' Open tempfile read, add day of week then delete tempfile
Set objFile = fso.OpenTextFile(TempFile, ForReading)
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
If colMatches.Count > 0 Then
For Each strMatch in colMatches
' Display weekday name for Holidays and AnnvYear with Current year
If Year(left(strSearchString,InStr(strSearchString," ")-1))=Year(DATE) then
strSearchString= WeekDayName(WeekDay(mid(strSearchString,1,2)&"/" & Mid(strSearchString,4,2)&"/"&(year(Date)))) & ": " & strSearchString
' Display weekday name and year count
Else
strSearchString= WeekDayName(WeekDay(mid(strSearchString,1,2)&"/" & Mid(strSearchString,4,2)&"/"&(year(Date)))) & ": " & strSearchString & ": " & DateDiff("y",year(Left(strSearchString,10)),Year(Date)) & " Years"
END IF
msg1 = msg1 & strsearchstring & vbcrlf
Next
END IF
Loop
objFile.Close
' Create Calendar to add to message box Thanks lba
m = Month(date)
y = Year(Date)
w = Weekday(DateSerial(y, m, 1), w1) -1
l = Day(DateSerial(y, m+1, 0)) +w
' First line Day Names
For i = 1 To 7
o = o & " " & WeekdayName(i ,True) & " "
Next
' Date numbers
o = o & vbCrLf
For i = 1 To l
d = i - w
IF d < 1 Then
o = o & " -- "
ELSE IF Len(d)= 1 then
o = o & " " & d & " "
ELSE
o = o & " " & d & " "
END IF
END IF
If (i-1) Mod 7 = 6 Then
o = o & vbCrLf
End If
Next
' Display results
MsgBox Msg1 & vbCrLf & o,," Special Days of " & MonthName(Month(Date))& " " & Year(Date)
' Delete Tempfile
fso.DeleteFile(Tempfile)
Case 2 ' View Next Month
Set objRegEx = CreateObject("VBScript.RegExp")
DateSearch = Right(String(2,"0") & Month(DateAdd("M",1,date)), 2)
objRegEx.Pattern = "^" & DateSearch
Set objFile = fso.OpenTextFile(FileName, ForReading)
Set arrLines = CreateObject("System.Collections.ArrayList")
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
If colMatches.Count > 0 Then
For Each strMatch in colMatches
arrLines.Add(strSearchString)
Next
END IF
Loop
' Filter, Add & sort Holidays for calendar month
For i=0 to 11
Set colMatches = objRegEx.Execute(hol(i))
If colMatches.Count > 0 Then
For Each strMatch in colMatches
arrLines.Add(hol(i))
arrLines.sort()
Next
End if
Next
' Write all special dates to new file so day of week can be added
Dim TempFile2
tempfile2= "c:\Dates.txt"
set objFile = FSO.OpenTextFile(TempFile2, ForAppending, True)
objFile.Close
'Join the array with Line feed
Dim strNewFile2 : strNewFile2 = Join(arrLines.ToArray, vbCrLf)
'Re-open the file for reading
Set objFile = fso.OpenTextFile(TempFile2, ForWriting, False)
'Write the new text
objFile.Write strNewFile2
objFile.Close
' Open tempfile read, add day of week then delete tempfile
Set objFile = fso.OpenTextFile(TempFile2, ForReading)
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
If colMatches.Count > 0 Then
For Each strMatch in colMatches
' Display weekday name for January Holidays
If Year(left(strSearchString,InStr(strSearchString," ")-1))=DateAdd("Y",1,Year(DATE)) then
strSearchString= WeekDayName(WeekDay(DateAdd("yyyy",1,(mid(strSearchString,1,2)&"/" & Mid(strSearchString,4,2)&"/"&(Year(Date)))))) & ": " & strSearchString
' Current Month is 12, AnnvMonth is 01 display weekday and total years for next year
ElseIf Month(Date)="12" and Left(strSearchString,2) ="01" And Mid(strSearchString,6,1)="/" then
strSearchString= WeekDayName(WeekDay(DateAdd("yyyy",1,(mid(strSearchString,1,2)&"/" & Mid(strSearchString,4,2)&"/"&(Year(Date)))))) & ": " & strSearchString & ": " & DateDiff("y",year(Left(strSearchString,10)),Year(Date))+1 & " Years"
' Current Month is 12, AnnvMonth is 01 with no AnnvYear then diplay correct weekday name
ElseIf Month(Date)="12" and Left(strSearchString,2) ="01" And Mid(strSearchString,6,1)=" " then
strSearchString= WeekDayName(WeekDay(DateAdd("yyyy",1,(mid(strSearchString,1,2)&"/" & Mid(strSearchString,4,2)&"/"&(Year(Date)))))) & ": " & strSearchString
' Display current Weekday name for Annv date without year or holidays
Elseif Year(left(strSearchString,InStr(strSearchString," ")-1))=Year(DATE) then
strSearchString= WeekDayName(WeekDay(mid(strSearchString,1,2)&"/" & Mid(strSearchString,4,2)&"/"&(year(Date())))) & ": " & strSearchString
' Display weekday name and calculate years
Else
strSearchString= WeekDayName(WeekDay(mid(strSearchString,1,2)&"/" & Mid(strSearchString,4,2)&"/"&(year(Date())))) & ": " & strSearchString & ": " & DateDiff("y",year(Left(strSearchString,10)),Year(Date)) & " Years"
END IF
msg1 = msg1 & strsearchstring & vbcrlf
Next
END IF
Loop
objFile.Close
' Create Calendar for next month to add to message box Thanks lba
m = Month(DateAdd("M",1,date))
' If current month is Dec, want to display Next month and year calendar
If Month(date) = "12" then
Y =Year(DateAdd("YYYY",1,date))
ELSE
Y = Year(Date)
END IF
w = Weekday(DateSerial(y, m, 1), w1) -1
l = Day(DateSerial(y, m+1, 0)) +w
' First line Day Names
For i = 1 To 7
o = o & " " & WeekdayName(i ,True) & " "
Next
' Date
o = o & vbCrLf
For i = 1 To l
d = i - w
If d < 1 Then
o = o & " -- "
else If Len(d)= 1 then
o = o & " " & d & " "
Else
o = o & " " & d & " "
End if
End If
If (i-1) Mod 7 = 6 Then
o = o & vbCrLf
End If
Next
' Display results
MsgBox Msg1 & vbCrLf & o,," Special Days of " & MonthName(Month(DateAdd("M",1,date))) & " " & Y
' Delete Tempfile
fso.DeleteFile(Tempfile2)
Case 3 ' Add New Date
Notice = "Add Special Date to List"
Question = InputBox ("Enter Date and Name as" & vbCR & vbCR & "''MM/DD/YYYY Name''"& vbCR &" or"& vbCR & "''MM/DD Name''", Notice)
' Check for Null or empty inputbox then cancels
IF IsEmpty(Question) THEN
WScript.quit()
ELSEIF Len(Question) = 0 THEN
WScript.quit()
ELSE
If (fso.FileExists(FileName)) Then
set objFile = FSO.OpenTextFile(FileName, ForAppending, True)
objFile.WriteLine (vbCrLf & Question)
Else
set objFile = FSO.OpenTextFile(FileName, ForAppending, True)
objFile.WriteLine (Question)
objFile.Close
End if
Set arrLines = CreateObject("System.Collections.ArrayList")
'Open the file
Set objFile = fso.OpenTextFile(FileName, ForReading, False)
'Loop thru and add each line to the array
Do Until objFile.AtEndOfStream
strLine = Trim(objFile.ReadLine)
If Len(strLine) > 0 Then
'Verify that array doesn't already have the entry
If Not arrLines.Contains(strLine) Then arrLines.Add(strLine)
End if
Loop
objFile.Close
'Sort (ascending) for aesthetics
arrLines.Sort()
'Join the array with vbCrLf (carriage return or enter)
Dim strNewFile1 : strNewFile1 = Join(arrLines.ToArray, vbCrLf)
'Re-open the file for reading
Set objFile = fso.OpenTextFile(FileName, ForWriting, False)
'Write the new text
objFile.Write strNewFile1
objFile.Close
MsgBox "Special Date and Name Entered", ,Notice
END IF
Case 4 ' Remove Date
Set fso = CreateObject("Scripting.FileSystemObject")
Notice ="Which Month?"
Question = InputBox("Type the Number of the Month would you like to view?" & vbCrLf & vbCrLf & "Enter as a number 1 - 12",Notice)
Set objRegEx = CreateObject("VBScript.RegExp")
DateSearch = Right(String(2,"0") & Question, 2)
objRegEx.Pattern = "^" & DateSearch
Set objFile = fso.OpenTextFile(FileName, ForReading)
' Find the dates from the list
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
If colMatches.Count > 0 Then
For Each strMatch in colMatches
Msg = Msg & " " & strSearchString & vbCrLf
Next
End If
Loop
objFile.Close
IF Len(Msg) = 0 THEN
Msgbox "There are no Dates in " & MonthName(Question) & " ",,"Special Days"
Else
Notice = "Type the Date, Name or Both to be removed."
Set objFile = fso.OpenTextFile(FileName, ForReading)
' Put the Array into in InputBox
Question = InputBox("The Date and Name are Case Sensitive!" & vbCrLf & "Be specific the less you type the more will be matched and deleted." & vbCrLf & vbCrLf & Msg,Notice)
' Check if Inputbox is empty, cancel if empty
IF IsEmpty(Question) THEN
WScript.quit()
ELSEIF Len(Question) = 0 THEN
WScript.quit()
ELSE
'Delete Item in Question
Set objFile = fso.OpenTextFile(FileName, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
If InStr(strLine, Question) = 0 Then
strNewContents = strNewContents & strLine & vbCrLf
End If
Loop
End if
objFile.Close
' Rewrite remaining items to file
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFile = FSO.OpenTextFile(FileName, ForWriting)
objFile.Write strNewContents
objFile.Close
end if
END SELECT
End Sub
' Error handling message
IF Err.Number <> 0 THEN
Msgbox "You entered something incorrectly. Try again. ",0+16," Ooopps...."
WScript.quit()
END IF
Click Start => click Programs => click Accessories => click Notepad
Or
Click Start => Click Run => Type Notepad in the Run input box then Click OK.
2) Copy the code below the Apostrophe and Asterisks line then Paste it into Notepad.
' *********************************************
Dim Notice
Dim Message
Dim fso
Dim objFile
Dim arrLines
Dim arrList
Dim FileName
Dim Hol(12)
Set fso = CreateObject("Scripting.FileSystemObject")
FileName = "c:\MySpecialDates.txt"
Const ForReading = 1
Const ForWriting = 2 'will over write everything
Const ForAppending = 8 'will create or append file
' this code will create the Data file
If (fso.FileExists(FileName))= False Then
set objFile = FSO.OpenTextFile(FileName, ForAppending, True)
objFile.Close
End if
' Error Handling
On Error Resume Next
' Standard Inputbox
Notice = " My Special Dates - Today is " & WeekDayNAme(WeekDay(Date)) & " " & Date
Message = "What would you like to do ?" & vbcr & vbcr &_
"1 - View Dates for This month " & vbcr &_
"2 - View Dates for Next month " & vbcr &_
"3 - Add a Date and Name to your List " & vbCr &_
"4 - Remove a Date and Name from your List" & vbcr & vbcr &_
"Enter the number of your choice."
' InputBox results
Question = InputBox(message,Notice)
' Check for Null or empty inputbox then cancels
IF IsEmpty(Question) THEN
WScript.quit()
ELSEIF Len(Question) = 0 THEN
WScript.quit()
ELSEIF Question = 0 THEN
WScript.quit()
ELSE
SELECT Case Question
Case 1 Run(1)
Case 2 Run(2)
Case 3 Run(3)
Case 4 Run(4)
END SELECT
END IF
' Case Statements for result
Sub Run(var)
Set WS = CreateObject("WScript.shell")
' January
' This checks if current month is Dec to decide which holiday date to use
IF Month(date) = "12" then
Hol(0)="01/01/"& Right(DateSerial(Year(Date)+1,1,1),4) & " New Year's Day"
Hol(1) = "0"& DateSerial(Year(Date)+1,1,22) - Weekday(DateSerial(Year(Date)+1,1,22),3) & " MLK Day"
ELSE
Hol(0)="01/01/"&Right(DateSerial(Year(Date),1,1),4) & " New Year's Day"
Hol(1) = "0"& DateSerial(Year(Date),1,22) - Weekday(DateSerial(Year(Date),1,22),3) & " MLK Day"
END IF
' February
Hol(2) = "02/14/"&Year(Date) & " Valentine's Day"
Hol(3) = "0"&DateSerial(Year(Date),3,1) - Weekday(DateSerial(Year(Date),3,1),3) - 7 &" President's Day"
' May
Hol(4) = "0" &DateSerial(Year(Date),6,1) - Weekday(DateSerial(Year(Date),6,1),3) & " Memorial Day"
' July
Hol(5) = "07/04/" & Year(Date) & " Independence Day"
' September
Hol(6) = "09/0"&Mid(DateSerial(Year(Date),9,8) - Weekday(DateSerial(Year(Date),9,8),3),3,1)&"/" & Year(Date)& " Labor Day"
' October
Hol(7) = DateSerial(Year(Date),10,15) - Weekday(DateSerial(Year(Date),10,15),3) & " Columbus Day"
' November
Hol(8) = DateSerial(Year(Date),11,11) & " Veterans' Day"
Hol(9) = DateSerial(Year(Date),11,29) - Weekday(DateSerial(Year(Date),11,29),6) &" Thanksgiving Day"
' December
Hol(10) = DateSerial(Year(Date),12,25) & " Christmas Day"
Hol(11)= DateSerial(Year(Date),12,31) & " New Year's Eve"
Select Case var
Case 1 ' View Current Month
Set objRegEx = CreateObject("VBScript.RegExp")
DateSearch = Right(String(2,"0") & Month(Date), 2)
objRegEx.Pattern = "^" & DateSearch
Set objFile = fso.OpenTextFile(FileName, ForReading)
Set arrLines = CreateObject("System.Collections.ArrayList")
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
IF colMatches.Count > 0 Then
For Each strMatch in colMatches
arrLines.Add(strSearchString)
Next
END IF
Loop
' Filter, Add & sort Holidays for calendar month
For i=0 to 11
Set colMatches = objRegEx.Execute(hol(i))
IF colMatches.Count > 0 Then
For Each strMatch in colMatches
arrLines.Add(hol(i))
arrLines.sort()
Next
END IF
Next
' Write all special dates to new file so day of week can be added
Dim TempFile
tempfile= "c:\Dates.txt"
set objFile = FSO.OpenTextFile(TempFile, ForAppending, True)
objFile.Close
'Join the array with Line feed
Dim strNewFile : strNewFile = Join(arrLines.ToArray, vbCrLf)
'Re-open the file for reading
Set objFile = fso.OpenTextFile(TempFile, ForWriting, False)
'Write the new text
objFile.Write strNewFile
objFile.Close
' Open tempfile read, add day of week then delete tempfile
Set objFile = fso.OpenTextFile(TempFile, ForReading)
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
If colMatches.Count > 0 Then
For Each strMatch in colMatches
' Display weekday name for Holidays and AnnvYear with Current year
If Year(left(strSearchString,InStr(strSearchString," ")-1))=Year(DATE) then
strSearchString= WeekDayName(WeekDay(mid(strSearchString,1,2)&"/" & Mid(strSearchString,4,2)&"/"&(year(Date)))) & ": " & strSearchString
' Display weekday name and year count
Else
strSearchString= WeekDayName(WeekDay(mid(strSearchString,1,2)&"/" & Mid(strSearchString,4,2)&"/"&(year(Date)))) & ": " & strSearchString & ": " & DateDiff("y",year(Left(strSearchString,10)),Year(Date)) & " Years"
END IF
msg1 = msg1 & strsearchstring & vbcrlf
Next
END IF
Loop
objFile.Close
' Create Calendar to add to message box Thanks lba
m = Month(date)
y = Year(Date)
w = Weekday(DateSerial(y, m, 1), w1) -1
l = Day(DateSerial(y, m+1, 0)) +w
' First line Day Names
For i = 1 To 7
o = o & " " & WeekdayName(i ,True) & " "
Next
' Date numbers
o = o & vbCrLf
For i = 1 To l
d = i - w
IF d < 1 Then
o = o & " -- "
ELSE IF Len(d)= 1 then
o = o & " " & d & " "
ELSE
o = o & " " & d & " "
END IF
END IF
If (i-1) Mod 7 = 6 Then
o = o & vbCrLf
End If
Next
' Display results
MsgBox Msg1 & vbCrLf & o,," Special Days of " & MonthName(Month(Date))& " " & Year(Date)
' Delete Tempfile
fso.DeleteFile(Tempfile)
Case 2 ' View Next Month
Set objRegEx = CreateObject("VBScript.RegExp")
DateSearch = Right(String(2,"0") & Month(DateAdd("M",1,date)), 2)
objRegEx.Pattern = "^" & DateSearch
Set objFile = fso.OpenTextFile(FileName, ForReading)
Set arrLines = CreateObject("System.Collections.ArrayList")
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
If colMatches.Count > 0 Then
For Each strMatch in colMatches
arrLines.Add(strSearchString)
Next
END IF
Loop
' Filter, Add & sort Holidays for calendar month
For i=0 to 11
Set colMatches = objRegEx.Execute(hol(i))
If colMatches.Count > 0 Then
For Each strMatch in colMatches
arrLines.Add(hol(i))
arrLines.sort()
Next
End if
Next
' Write all special dates to new file so day of week can be added
Dim TempFile2
tempfile2= "c:\Dates.txt"
set objFile = FSO.OpenTextFile(TempFile2, ForAppending, True)
objFile.Close
'Join the array with Line feed
Dim strNewFile2 : strNewFile2 = Join(arrLines.ToArray, vbCrLf)
'Re-open the file for reading
Set objFile = fso.OpenTextFile(TempFile2, ForWriting, False)
'Write the new text
objFile.Write strNewFile2
objFile.Close
' Open tempfile read, add day of week then delete tempfile
Set objFile = fso.OpenTextFile(TempFile2, ForReading)
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
If colMatches.Count > 0 Then
For Each strMatch in colMatches
' Display weekday name for January Holidays
If Year(left(strSearchString,InStr(strSearchString," ")-1))=DateAdd("Y",1,Year(DATE)) then
strSearchString= WeekDayName(WeekDay(DateAdd("yyyy",1,(mid(strSearchString,1,2)&"/" & Mid(strSearchString,4,2)&"/"&(Year(Date)))))) & ": " & strSearchString
' Current Month is 12, AnnvMonth is 01 display weekday and total years for next year
ElseIf Month(Date)="12" and Left(strSearchString,2) ="01" And Mid(strSearchString,6,1)="/" then
strSearchString= WeekDayName(WeekDay(DateAdd("yyyy",1,(mid(strSearchString,1,2)&"/" & Mid(strSearchString,4,2)&"/"&(Year(Date)))))) & ": " & strSearchString & ": " & DateDiff("y",year(Left(strSearchString,10)),Year(Date))+1 & " Years"
' Current Month is 12, AnnvMonth is 01 with no AnnvYear then diplay correct weekday name
ElseIf Month(Date)="12" and Left(strSearchString,2) ="01" And Mid(strSearchString,6,1)=" " then
strSearchString= WeekDayName(WeekDay(DateAdd("yyyy",1,(mid(strSearchString,1,2)&"/" & Mid(strSearchString,4,2)&"/"&(Year(Date)))))) & ": " & strSearchString
' Display current Weekday name for Annv date without year or holidays
Elseif Year(left(strSearchString,InStr(strSearchString," ")-1))=Year(DATE) then
strSearchString= WeekDayName(WeekDay(mid(strSearchString,1,2)&"/" & Mid(strSearchString,4,2)&"/"&(year(Date())))) & ": " & strSearchString
' Display weekday name and calculate years
Else
strSearchString= WeekDayName(WeekDay(mid(strSearchString,1,2)&"/" & Mid(strSearchString,4,2)&"/"&(year(Date())))) & ": " & strSearchString & ": " & DateDiff("y",year(Left(strSearchString,10)),Year(Date)) & " Years"
END IF
msg1 = msg1 & strsearchstring & vbcrlf
Next
END IF
Loop
objFile.Close
' Create Calendar for next month to add to message box Thanks lba
m = Month(DateAdd("M",1,date))
' If current month is Dec, want to display Next month and year calendar
If Month(date) = "12" then
Y =Year(DateAdd("YYYY",1,date))
ELSE
Y = Year(Date)
END IF
w = Weekday(DateSerial(y, m, 1), w1) -1
l = Day(DateSerial(y, m+1, 0)) +w
' First line Day Names
For i = 1 To 7
o = o & " " & WeekdayName(i ,True) & " "
Next
' Date
o = o & vbCrLf
For i = 1 To l
d = i - w
If d < 1 Then
o = o & " -- "
else If Len(d)= 1 then
o = o & " " & d & " "
Else
o = o & " " & d & " "
End if
End If
If (i-1) Mod 7 = 6 Then
o = o & vbCrLf
End If
Next
' Display results
MsgBox Msg1 & vbCrLf & o,," Special Days of " & MonthName(Month(DateAdd("M",1,date))) & " " & Y
' Delete Tempfile
fso.DeleteFile(Tempfile2)
Case 3 ' Add New Date
Notice = "Add Special Date to List"
Question = InputBox ("Enter Date and Name as" & vbCR & vbCR & "''MM/DD/YYYY Name''"& vbCR &" or"& vbCR & "''MM/DD Name''", Notice)
' Check for Null or empty inputbox then cancels
IF IsEmpty(Question) THEN
WScript.quit()
ELSEIF Len(Question) = 0 THEN
WScript.quit()
ELSE
If (fso.FileExists(FileName)) Then
set objFile = FSO.OpenTextFile(FileName, ForAppending, True)
objFile.WriteLine (vbCrLf & Question)
Else
set objFile = FSO.OpenTextFile(FileName, ForAppending, True)
objFile.WriteLine (Question)
objFile.Close
End if
Set arrLines = CreateObject("System.Collections.ArrayList")
'Open the file
Set objFile = fso.OpenTextFile(FileName, ForReading, False)
'Loop thru and add each line to the array
Do Until objFile.AtEndOfStream
strLine = Trim(objFile.ReadLine)
If Len(strLine) > 0 Then
'Verify that array doesn't already have the entry
If Not arrLines.Contains(strLine) Then arrLines.Add(strLine)
End if
Loop
objFile.Close
'Sort (ascending) for aesthetics
arrLines.Sort()
'Join the array with vbCrLf (carriage return or enter)
Dim strNewFile1 : strNewFile1 = Join(arrLines.ToArray, vbCrLf)
'Re-open the file for reading
Set objFile = fso.OpenTextFile(FileName, ForWriting, False)
'Write the new text
objFile.Write strNewFile1
objFile.Close
MsgBox "Special Date and Name Entered", ,Notice
END IF
Case 4 ' Remove Date
Set fso = CreateObject("Scripting.FileSystemObject")
Notice ="Which Month?"
Question = InputBox("Type the Number of the Month would you like to view?" & vbCrLf & vbCrLf & "Enter as a number 1 - 12",Notice)
Set objRegEx = CreateObject("VBScript.RegExp")
DateSearch = Right(String(2,"0") & Question, 2)
objRegEx.Pattern = "^" & DateSearch
Set objFile = fso.OpenTextFile(FileName, ForReading)
' Find the dates from the list
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
If colMatches.Count > 0 Then
For Each strMatch in colMatches
Msg = Msg & " " & strSearchString & vbCrLf
Next
End If
Loop
objFile.Close
IF Len(Msg) = 0 THEN
Msgbox "There are no Dates in " & MonthName(Question) & " ",,"Special Days"
Else
Notice = "Type the Date, Name or Both to be removed."
Set objFile = fso.OpenTextFile(FileName, ForReading)
' Put the Array into in InputBox
Question = InputBox("The Date and Name are Case Sensitive!" & vbCrLf & "Be specific the less you type the more will be matched and deleted." & vbCrLf & vbCrLf & Msg,Notice)
' Check if Inputbox is empty, cancel if empty
IF IsEmpty(Question) THEN
WScript.quit()
ELSEIF Len(Question) = 0 THEN
WScript.quit()
ELSE
'Delete Item in Question
Set objFile = fso.OpenTextFile(FileName, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
If InStr(strLine, Question) = 0 Then
strNewContents = strNewContents & strLine & vbCrLf
End If
Loop
End if
objFile.Close
' Rewrite remaining items to file
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFile = FSO.OpenTextFile(FileName, ForWriting)
objFile.Write strNewContents
objFile.Close
end if
END SELECT
End Sub
' Error handling message
IF Err.Number <> 0 THEN
Msgbox "You entered something incorrectly. Try again. ",0+16," Ooopps...."
WScript.quit()
END IF
Save the File
1) Click File,
2) Click Save,
3) Choose the location where to Save this file,
4) Change Save as type: from Text Documents (*.txt) to "All Files",
5) Give the file a name i.e. SpecialDateTracker.vbs,
6) Click Save.
Congratulations you are done. Now go and add your special dates to your VBS Special Date Tracker.
2) Click Save,
3) Choose the location where to Save this file,
4) Change Save as type: from Text Documents (*.txt) to "All Files",
5) Give the file a name i.e. SpecialDateTracker.vbs,
6) Click Save.
Congratulations you are done. Now go and add your special dates to your VBS Special Date Tracker.
Observations & Summary
1) This VBS Special Date Tracker is simple enough and has room for you to customize its functionality. e.g. add more error handling, change holidays, add whatever you want.
2) It is small and easy to use.
3) It still has error handling if you enter something outside of normal parameters.
4) The visual calendar is very helpful.
Summary
I am satisfied with the results. I use it a lot now to see what holidays or special days, when they will be and how many years.
Then I saw, and considered it well. I looked upon it, and received instruction..