2020 年の海の日、山の日および体育の日を移動するスクリプト

6 月 13 日に 2020 年の海の日、山の日および体育の日が東京オリンピックに合わせて移動されるという法律が可決、成立しました。

今後、この法律に基づいて更新された Outlook の祝日ファイルも更新プログラムとして提供されることになると思いますが、すでに延長サポート フェーズに入っている Outlook 2013 や Outlook 2010 には提供されない可能性があります。
また、Outlook 2016 でも、更新プログラムを適用すれば変更されるというわけではなく、いったん祝日を削除して改めて追加するという作業が必要になります。

そのようなわけで、祝日を移動するスクリプトを作ってみました。
スクリプトは以下の通りです。

' ここをトリプルクリックでスクリプト全体を選択できます。

Const olFolderCalendar = 9
Dim olkApp
Dim fldCal
' Outlook の予定表を取得
Set olkApp = CreateObject("Outlook.Application")
Set fldCal = olkApp.Session.GetDefaultFolder(olFolderCalendar)
' 祝日ごとに移動
MoveHoliday fldCal, "海の日", "7/20", "7/23"
MoveHoliday fldCal, "山の日", "8/11", "8/10"
MoveHoliday fldCal, "体育の日", "10/12", "7/24"
' 一つの祝日を移動するプロシージャ
Sub MoveHoliday(fldCal, strName, strStart, strNewStart)
     Dim apptHol
     ' 件名と日付により祝日を検索
     Set apptHol = fldCal.Items.Find("[件名]='" & strName & _
         "' And [開始日]='2020/" & strStart & " 00:00'")
     ' 見つかったら新しい日付に移動
     If Not apptHol Is Nothing Then
         apptHol.Start = CDate("2020/" & strNewStart)
         apptHol.Save
     End If
End Sub


広告