スクリプトは以下の通りです。下記のスクリプトを AddHoliday.vbs という名前で保存し、ダブルクリックして実行すると、2008 年以降の祝日が 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
' 予定表から 2008 年以降の祝日のみを取得
Set objHoliday = colEvents.Find("[分類項目] = '祝日' AND [開始日] >= '2007/12/31' AND [場所] = '日本'")
' 2008 年以降の祝日を削除
While Not objHoliday Is Nothing
objHoliday.Delete
Set objHoliday = colEvents.FindNext
Wend
'
' 2008 年から 2012 年までの祝日を追加
For iYear = 2008 to 2012
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 "春分の日", 2008, 3, 20
AddNormalHoliday "春分の日", 2009, 3, 20
AddNormalHoliday "春分の日", 2010, 3, 21
AddNormalHoliday "春分の日", 2011, 3, 21
AddNormalHoliday "春分の日", 2012, 3, 20
AddNormalHoliday "秋分の日", 2008, 9, 23
AddNormalHoliday "国民の休日", 2009, 9, 22
AddNormalHoliday "秋分の日", 2009, 9, 23
AddNormalHoliday "秋分の日", 2010, 9, 23
AddNormalHoliday "秋分の日", 2011, 9, 23
AddNormalHoliday "秋分の日", 2012, 9, 22
' - ここに祝日を追加します
' 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＜参考＞
