Outlook予定表にVBAで有給休暇等の予定を登録するマクロ

Outlookをメーラーとして利用している会社も多いと思います。
Outlookの予定表上で、アクティブにしている日にちに、ワンクリックで有給休暇等の終日の予定を登録するプロシージャをご紹介します。

Sub sb予定表登録_有給休暇()
    Dim objApItem As Outlook.appointmentItem
    Set objApItem = Application.CreateItem(olAppointmentItem)
   
    Dim oExpl As Outlook.Explorer
    Dim oView As Outlook.View
    Dim oCalView As CalendarView
    Dim datStart As Date
    Dim datEnd As Date
   
    Set oExpl = Application.activeExplorer
    Set oView = oExpl.CurrentView
   
    If oView.ViewType = olCalendarView Then 'もし予定表画面を開いているなら
        Set oCalView = oExpl.CurrentView
        datStart = DateValue(oView.SelectedStartTime)  '選択中の日付を取得(DateValueで日付のみ)
        datEnd = datStart + 1
       
        With objApItem
            .Subject = "有給休暇"
            .Start = datStart '終日の予定のため0:00
            .End = datEnd '終日の予定のため0:00
            .AllDayEvent = True     '終日の予定TRUEならStart・Endの時間に関わらず0:00へ強制的に変更となる（ただし公開方法は空き時間）
            .BusyStatus = olBusy    '公開情報＝予定あり
            .Categories = "プライベート"  '分類項目（個人の設定によるため未登録ならコメントアウトする）
            .ReminderSet = True
            .ReminderMinutesBeforeStart = 720  '720分＝12時間で半日前（予定の開始前にアラームが発生する必要がある分数）
            .Save
        End With
    Else
        '予定表画面でない画面（例：メール画面）で実行する場合には、実行せず終了する
         MsgBox "処理未実行で終了です。", , "処理結果通知"
        Exit Sub
    End If
 
    MsgBox "処理が終了しました。", , "処理結果通知"
   
End Sub

予定表のクイックアクセスツールバーに登録して、Outlook予定表で有給休暇等の予定を登録したい日付をアクティブにした状態でマクロを実行してください。