2019 年以降の祝日の追加、変更を行うスクリプト


12 月 14 日に「天皇の即位の日及び即位礼正殿の儀の行われる日を休日とする法律」が公布されました。

今後、この法律に基づいて更新された Outlook の祝日ファイルも更新プログラムとして提供されることになると思いますが、すでに延長サポート フェーズに入っている Outlook 2013 や Outlook 2010 には提供されない可能性があります。
また、Outlook 2016 でも、更新プログラムを適用すれば変更されるというわけではなく、いったん祝日を削除して改めて追加するという作業が必要になります。
さらに、2020 年にはオリンピックに伴う祝日の移動や、「体育の日」から「スポーツの日」への変更、天皇誕生日の変更などもあるので、2019 年から 2016  年までの祝日を追加するスクリプトを作ってみました。
なお、法律の条文などを見ても、新しい祝日の正式な呼称がわからなかったため、5/1 を「即位の日」、10/22 を「即位礼正殿の儀の日」としています。

' ここをトリプル クリックするとすべてのコードが選択できます。
'
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
' 予定表から 2019 年以降の祝日のみを取得
Set objHoliday = colEvents.Find("[分類項目] = '祝日' AND [開始日] >= '2018/12/31' AND [場所] = '日本'")
' 2019 年以降の祝日を削除
While Not objHoliday Is Nothing
     objHoliday.Delete
     Set objHoliday = colEvents.FindNext
Wend
'
' 2019 年から 2026 年までの祝日を追加
For iYear = 2019 to 2026
     AddNormalHoliday "勤労感謝の日", iYear, 11, 23
     AddNormalHoliday "文化の日", iYear, 11, 3
     AddHappyMonday "敬老の日", iYear, 9, 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
     ' 2019 年の新天皇即位に伴う祝日
     If iYear = 2019 Then
         AddNormalHoliday "国民の休日", iYear, 4, 30
         AddNormalHoliday "即位の日", iYear, 5, 1
         AddNormalHoliday "国民の休日", iYear, 5, 2
         AddNormalHoliday "即位礼正殿の儀の日", iYear, 10, 22
     End If
     ' 2020 以降は天皇誕生日が 2/23 に
     If iYear >= 2020 Then
         AddNormalHoliday "天皇誕生日", iYear, 2, 23
     End If
     ' 2021 以降は正常
     If iYear >= 2021 Then
         ' 体育の日はスポーツの日に
         AddHappyMonday "スポーツの日", iYear, 10, 2
         AddNormalHoliday "山の日", iYear, 8, 11
         AddHappyMonday "海の日", iYear, 7, 3
     End If
Next
' 日付が一定でない祝日の追加
AddNormalHoliday "春分の日", 2019, 3, 21
AddNormalHoliday "春分の日", 2020, 3, 20
AddNormalHoliday "春分の日", 2021, 3, 20
AddNormalHoliday "春分の日", 2022, 3, 21
AddNormalHoliday "春分の日", 2023, 3, 21
AddNormalHoliday "春分の日", 2024, 3, 20
AddNormalHoliday "春分の日", 2025, 3, 20
AddNormalHoliday "春分の日", 2026, 3, 20
AddNormalHoliday "秋分の日", 2019, 9, 23
AddNormalHoliday "秋分の日", 2020, 9, 22
AddNormalHoliday "秋分の日", 2021, 9, 23
AddNormalHoliday "秋分の日", 2022, 9, 23
AddNormalHoliday "秋分の日", 2023, 9, 23
AddNormalHoliday "秋分の日", 2024, 9, 22
AddNormalHoliday "秋分の日", 2025, 9, 23
AddNormalHoliday "秋分の日", 2026, 9, 23
' 敬老の日と秋分の日に挟まれるため
AddNormalHoliday "国民の休日", 2026, 9, 22
' 2020 年の祝日移動のための特別処理
AddNormalHoliday "海の日", 2019, 7, 15
AddNormalHoliday "山の日", 2019, 8, 11
AddNormalHoliday "山の日 (振替休日)", 2019, 8, 12
AddNormalHoliday "体育の日", 2019, 10, 14
AddNormalHoliday "海の日", 2020, 7, 23
AddNormalHoliday "山の日", 2020, 8, 10
AddNormalHoliday "スポーツの日", 2020, 7, 24
'
' 振り替え休日を考慮しない祝日の追加
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

広告

2019 年以降の祝日の追加、変更を行うスクリプト」への3件のフィードバック

  1. 大みそか、12月31日がなかったので、追加しました。

    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
    ‘ 予定表から 2019 年以降の祝日のみを取得
    Set objHoliday = colEvents.Find(“[分類項目] = ‘祝日’ AND [開始日] >= ‘2018/12/31’ AND [場所] = ‘日本'”)
    ‘ 2019 年以降の祝日を削除
    While Not objHoliday Is Nothing
    objHoliday.Delete
    Set objHoliday = colEvents.FindNext
    Wend

    ‘ 2019 年から 2026 年までの祝日を追加
    For iYear = 2019 to 2026
    AddNormalHoliday “大みそか”, iYear, 12, 31
    AddNormalHoliday “勤労感謝の日”, iYear, 11, 23
    AddNormalHoliday “文化の日”, iYear, 11, 3
    AddHappyMonday “敬老の日”, iYear, 9, 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
    ‘ 2019 年の新天皇即位に伴う祝日
    If iYear = 2019 Then
    AddNormalHoliday “国民の休日”, iYear, 4, 30
    AddNormalHoliday “即位の日”, iYear, 5, 1
    AddNormalHoliday “国民の休日”, iYear, 5, 2
    AddNormalHoliday “即位礼正殿の儀の日”, iYear, 10, 22
    End If
    ‘ 2020 以降は天皇誕生日が 2/23 に
    If iYear >= 2020 Then
    AddNormalHoliday “天皇誕生日”, iYear, 2, 23
    End If
    ‘ 2021 以降は正常
    If iYear >= 2021 Then
    ‘ 体育の日はスポーツの日に
    AddHappyMonday “スポーツの日”, iYear, 10, 2
    AddNormalHoliday “山の日”, iYear, 8, 11
    AddHappyMonday “海の日”, iYear, 7, 3
    End If
    Next
    ‘ 日付が一定でない祝日の追加
    AddNormalHoliday “春分の日”**** 20
    AddNormalHoliday “春分の日”**** 22
    AddNormalHoliday “秋分の日”, 2025, 9, 23
    AddNormalHoliday “秋分の日”, 2026, 9, 23
    ‘ 敬老の日と秋分の日に挟まれるため
    AddNormalHoliday “国民の休日”**** 2020, 8, 10
    AddNormalHoliday “スポーツの日”, 2020, 7, 24

    ‘ 振り替え休日を考慮しない祝日の追加
    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 = ‘” & _
    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

コメントを残す

以下に詳細を記入するか、アイコンをクリックしてログインしてください。

WordPress.com ロゴ

WordPress.com アカウントを使ってコメントしています。 ログアウト /  変更 )

Google フォト

Google アカウントを使ってコメントしています。 ログアウト /  変更 )

Twitter 画像

Twitter アカウントを使ってコメントしています。 ログアウト /  変更 )

Facebook の写真

Facebook アカウントを使ってコメントしています。 ログアウト /  変更 )

%s と連携中