VB Script for adding custom holidays and Appointments to Outlook 2007 calendar

EDN Admin

Well-known member
Joined
Aug 7, 2010
Messages
12,794
Location
In the Machine
I found this script online and it works great. We can customize it to add the US holidays, our Company Holidays, and Pay Dates. What I want to know is if it is possible to add a category to the Holiday so that it will stand out on the users
calendar.

<pre>script to add outlook holidays with no user intervention
Option Explicit
On Error Resume Next

Dim olkApp, olkCalendar, olkEvent, objFSO, objFile, arrItem, templine, tempcountry, tempcountryArray
Const ForReading = 1
Const OpenAsUnicode = -1
Path to *.hol file
Const strFilename = "C:Program Files (x86)Microsoft OfficeOFFICE121033OUTLOOK.HOL"
Define your country here
Const myCountry = "United States"


Set objFSO = CreateObject("Scripting.FileSystemObject")
***IMPORTANT - Need to open in ASCII format otherwise hol file wont read correctly after applying SP3
Set objFile = objFSO.OpenTextFile(strFilename, ForReading, False, OpenAsUnicode)
Set olkApp = CreateObject("Outlook.Application")
Obtain the default Calendar folder for the user who is currently logged on
Set olkCalendar = olkApp.GetNamespace("MAPI").GetDefaultFolder(9)


Do Until objFile.AtEndOfStream
Read a line from *.hol file
templine = objFile.ReadLine

Get the section name (sections are for each country)
If Left(templine,1) = "[" Then
tempcountryArray = Split(Right(templine,Len(templine)-1),"]")
tempcountry = tempcountryArray(0)
End If

If the current section is for our chosen country, proceed to updating holidays
If LCase(tempcountry) = LCase(myCountry) Then
If instr(templine,",") > 0 Then
arrItem = Split(templine, ",")
Set olkEvent = olkApp.CreateItem(1)
olkEvent.Subject = arrItem(0)
olkEvent.Start = arrItem(1)
olkEvent.AllDayEvent = True
olkEvent.ReminderSet = False
olkEvent.Save
End If
End If

Loop

If Err.Number <> 0 Then
MsgBox "A problem was encountered whilst updating your national holidays for MS Outlook 2003." & vbcrlf & "You may not currently be connected to your Microsoft Exchange Server." & VbCrLf & "To update your holidays manually at a later date:" & VbCrLf & VbCrLf &_
"Open MS Outlook 2003" & VbCrLf &_
"Click Tools > Options" & VbCrLf &_
"Under the Preferences tab, click Calendar Options..." & VbCrLf &_
"Click Add Holidays..." & VbCrLf &_
"Ensure the correct country is selected, click OK" & VbCrLf &_
"Click Yes", 0, "Please update your holidays manually"
End If


objFile.Close

Set olkEvent = Nothing
Set olkCalendar = Nothing
Set olkApp = Nothing
Set objFile = Nothing
Set objFSO = Nothing
[/code]



View the full article
 
Back
Top