How to add a holiday to a calendar using VB and CDO 1.21.

  • Article

' How to add a holiday to a calendar using VB and CDO 1.21.
'
' This example code shows how to add a holiday to a calendar using VB and CDO 1.21.
' Set a reference to CDO 1.21 and do the TODO sections in the code.
' Holidays are All Day Appointments with the Category of "Holiday" set.
'
' CDO 1.21 can be use on:
'   Exchange Server 2000
'   Exchange Server 2003
'   Exchange Server 2007 if CDO 1.21 is installed
'   Outlook 2002 if CDO 1.21 is installed (from Outlook CD)
'   Outlook 2003 if CDO 1.21 is installed (from Outlook CD)
'   Outlook 2007 if CDO 1.21 is installed (from Exchange 2007 CDO download)
'
' If CDO 1.21 is used on an Exchange Server, then it needs to run on an
' account with permission to each mailbox it accesses.
'
' When CDO 1.21 is used on an Outlook client, the code is usually accessing the mailbox
' of the user who is currently logged-in. If the code needs to access a different mailbox,
' then permission must be granted to that user for that mailbox.

Dim oSession As MAPI.Session
Dim oFolder As MAPI.Folder
Dim oMsgs As MAPI.Messages
Dim oAppt As MAPI.AppointmentItem
Dim i As Integer
Dim sServer As String
Dim sUser As String

Set oSession = New MAPI.Session
sServer = "smarthost" 'TODO: Change this to the name of your server.
sUser = "somebody" 'TODO: Change this to the name of an email recipient

' Set the localid and codepage - this needs to be set BEFORE calling Logon (only needed if you are
' not creating this in English
'oSession.SetLocaleIDs CLng(1041), CLng(932) ' Japanese
oSession.Logon , , False, True, , , sServer & vbLf & sUser

''oSession.SetOption "TimeZone", 10 ' Use if the times are off.  10 is EST.
'   'See:  Setting timezone options with CDO 1.21.
'     https://blogs.msdn.com/webdav_101/archive/2008/01/31/setting-timezone-options-with-cdo-1-21.aspx

' Get Calendar folder
Set oFolder = oSession.GetDefaultFolder(CdoDefaultFolderCalendar)

 

' Create a new Appointment
Set oMsgs = oFolder.Messages
Set oAppt = oMsgs.Add

Dim sCategories(10) As String
sCategories(0) = "Holiday"

' Set up properties on the appointment
With oAppt
    .Subject = "My Own Holiday"
    .Location = "Test here"
    .StartTime = #7/1/2004# ' DateAdd("h", 12, Date) ' Holiday is 7/1/2004.
    .EndTime = #7/2/2004# ' DateAdd("h", 13, Date) ' Holiday ends at to the start of this time/day
    .AllDayEvent = True
    .Text = "This is my test holiday"
    .BusyStatus = 0
    .ConversationTopic = "Personal Holiday"
    '.ReminderSet = True
    '.ReminderMinutesBeforeStart = 15
    .Categories = sCategories
    .Encrypted = True
End With

' Call Update to save the appointment to the calendar
oAppt.Update (True)

oSession.Logoff

' Clean Up
Set oMsgs = Nothing
Set oAppt = Nothing
Set oFolder = Nothing
Set oSession = Nothing

For information on how to do this with Outlook, please refer to the following:

  Outlook 2007
  https://office.microsoft.com/en-us/outlook/HP012304061033.aspx?pid=CH102499821033

  Outlook 2003
  https://office.microsoft.com/en-us/outlook/HA010750021033.aspx

  Outlook 2002
  https://office.microsoft.com/en-us/outlook/HA010347761033.aspx