Outlook の予定表に 2013 年以降の祝日を追加するスクリプト

Outlook では祝日の情報は通常の予定アイテムと同様のものであり、予定表のオプションから国を選んで追加する必要があります。
Outlook 2010 以降では 2013 年の祝日がリリース当初から含まれていますが、Outlook 2007 では修正プログラムの適用が必要であり、Outlook 2003 以前では祝日ファイルが提供されていません。
また、Outlook 2007 に修正プログラムを適用したり、Outlook 2007 以前から Outlook 2010 以降にアップグレードしたような場合、それだけでは予定表の祝日は更新されず、改めてインポートする必要があります。

そのため、以前、Outlook の予定表に 2008 年以降の祝日を追加するスクリプトを作ったのですが、このスクリプトでは 2012 年までの祝日が追加されていました。そろそろ 2013 年以降の祝日を追加するスクリプトも必要になるかと思ったので作ってみました。

スクリプトは以下の通りです。下記のスクリプトを AddHoliday.vbs という名前で保存し、ダブルクリックして実行すると、2013 年以降の祝日が Outlook の既定の予定表に追加されます。

' - ここをトリプル クリックするとすべてのコードが選択できます。
'
Option Explicit
Const olFolderCalendars = 9
Const olAppointmentItem = 1
Const olFree = 0
Dim objOutlook
Dim objSession
Dim objCalendar
Dim colEvents
Dim objHoliday
Dim iYear
' Outlook アプリケーション オブジェクトの取得
Set objOutlook = CreateObject("Outlook.Application")
' Namespace オブジェクトの取得
Set objSession = objOutlook.GetNamespace("MAPI")
' 予定表フォルダの取得
Set objCalendar = objSession.GetDefaultFolder(olFolderCalendars)
Set colEvents = objCalendar.Items
' 予定表から 2013 年以降の祝日のみを取得
Set objHoliday = colEvents.Find("[分類項目] = '祝日' AND [開始日] >= '2012/12/31' AND [場所] = '日本'")
' 2013 年以降の祝日を削除
While Not objHoliday Is Nothing
    objHoliday.Delete
    Set objHoliday = colEvents.FindNext
Wend
'
' 2013 年から 2017 年までの祝日を追加
For iYear = 2013 to 2017
    AddNormalHoliday "天皇誕生日", iYear, 12, 23
    AddNormalHoliday "勤労感謝の日", iYear, 11, 23
    AddNormalHoliday "文化の日", iYear, 11, 3
    AddHappyMonday "体育の日", iYear, 10, 2
    AddHappyMonday "敬老の日", iYear, 9, 3
    AddHappyMonday "海の日", iYear, 7, 3
    AddNormalHoliday "こどもの日", iYear, 5, 5
    AddNormalHoliday "みどりの日", iYear, 5, 4
    AddNormalHoliday "憲法記念日", iYear, 5, 3
    AddNormalHoliday "昭和の日", iYear, 4, 29
    AddNormalHoliday "建国記念の日", iYear, 2, 11
    AddHappyMonday "成人の日", iYear, 1, 2
    AddNormalHoliday "元日", iYear, 1, 1
Next
' 日付が一定でない祝日の追加
AddNormalHoliday "春分の日", 2013, 3, 20
AddNormalHoliday "春分の日", 2014, 3, 21
AddNormalHoliday "春分の日", 2015, 3, 21
AddNormalHoliday "春分の日", 2016, 3, 20
AddNormalHoliday "春分の日", 2017, 3, 20
AddNormalHoliday "秋分の日", 2013, 9, 23
AddNormalHoliday "秋分の日", 2014, 9, 23
AddNormalHoliday "国民の休日", 2015, 9, 22
AddNormalHoliday "秋分の日", 2015, 9, 23
AddNormalHoliday "秋分の日", 2016, 9, 22
AddNormalHoliday "秋分の日", 2017, 9, 23
' - ここに祝日を追加します
' AddNormalHoliday "創立記念日", 2008, 8, 28
'
' 振り替え休日を考慮しない祝日の追加
Sub AddHoliday( sName, dtDay )
    Set objHoliday = objOutlook.CreateItem(olAppointmentItem)
    objHoliday.Subject = sName
    objHoliday.Start = dtDay
    objHoliday.AllDayEvent = True
    objHoliday.Categories = "祝日"
    objHoliday.ReminderSet = False
    objHoliday.BusyStatus = olFree
    objHoliday.Location = "日本"
    objHoliday.Save
    Set objHoliday = Nothing
End Sub
'
' ハッピーマンデーの祝日の追加
Sub AddHappyMonday( sName, iYear, iMonth, iMonday )
    Dim iWk
    Dim iDay
    Dim dtDay
    iWk = Weekday(iYear & "/" & iMonth & "/1" )
    If iWk <= 2 Then
        iWk = iWk + 4
    Else
        iWk = iWk - 3
    End If
    iDay = 7 * iMonday - iWk
    AddHoliday sName, iYear & "/" & iMonth & "/" & iDay & " 00:00 AM"
End Sub
'
' 通常 (振り替え休日あり) の祝日の追加
Sub AddNormalHoliday( sName, iYear, iMonth, iDay )
    Dim iWk
    Dim dtSub
    Dim objHoliday
    AddHoliday sName, iYear & "/" & iMonth & "/" & iDay & " 00:00 AM"
    iWk = Weekday( iYear & "/" & iMonth & "/" & iDay )
    If iWk = 1 Then
        dtSub = CDate(iYear & "/" & iMonth & "/" & iDay)
        Do    ' 振替休日が国民の祝日だったら、翌日に繰り越し
            dtSub = DateAdd("d", 1, dtSub)
            Set objHoliday = colEvents.Find("[分類項目] = '祝日' AND [開始日] >= '" & _
                dtSub & " 00:00 AM' AND [終了日] <= '" & DateAdd("d", dtSub, 1) & _
                "' AND [場所] = '日本'")
        Loop While Not objHoliday Is Nothing
        AddHoliday "振替休日 (" & sName & ")", dtSub & " 00:00 AM"
    End If
End Sub

マクロの登録方法やメニューへの追加について

2013/03/09 追記:
Outlook 2003 用の祝日ファイルが下記のリンクより公開されました。
http://support.microsoft.com/kb/2834206/ja