[Outlook VBA]午後イチ会議のリマインダをお昼休み前に表示する

やりたいこと

午後イチに会議の予定が入っているとき、お昼休み中に何の意味もないリマインダが表示されて会議に遅れることがないように、リマインダの表示時間をお昼休み前にずらします。

仕様

Outlook VBAのイベントには「予定の保存」をトリガーにするイベントがないため、起動時にその日の予定からお昼休みにリマインダ表示される予定を抽出して、リマインダの時間を変更します。
このため、お昼休み終了後に起動した時は何もしないこととします。

• 昼休み時間
  • 12:00-13:00
• 変更後のリマインダ表示時間
  • 11:50

動作環境

• Outlook2016
  たぶんもっと前のバージョンでも動作します。

設定方法

1. [開発]タブから[Visual Basic]を選択し、Visual Basic for Applicationsを起動する。
2. 左側[プロジェクト]から[ThisOutlookSession]をダブルクリックし、VbaProject.OTM - ThisOutlookSession(コード)を開く。
3. 以下のソースをコピー&ペーストし、Visual Basic for Applicationを終了する。

※[開発]タブが表示されていない場合、以下の方法で表示する。

• [ファイル]-[オプション]でOutlookのオプションを開く。
• 左側から[リボンのユーザー設定]を選択し、右側[リボンのユーザー設定]でメインタブ[開発]にチェックを入れる。

ソース

Private Sub Application_Startup()
    
    ' 13:00以降に起動した場合は処理を実行しない
    If Now > DateAdd("h", 13, Date) Then
        Exit Sub
    End If
    
    ' Name Space
    Dim myNamespace As NameSpace
    Set myNamespace = GetNamespace("MAPI")
    
    ' 自分のカレンダーアイテムフォルダ
    Dim myFolder As Outlook.Folder
    Set myFolder = myNamespace.GetDefaultFolder(olFolderCalendar)
    
    ' カレンダーアイテム
    Dim myItems As Outlook.Items
    Set myItems = myFolder.Items
    
    ' 定期的な予定を含める
    myItems.IncludeRecurrences = True
    
    ' 開始日でソート
    myItems.Sort "[start]"
        
    ' 開始日を戻り値の日付でフィルタ
    Dim strFilter As String
    strFilter = "[Start] >= '" & Format$(Date, "mm/dd/yyyy hh:mm AMPM") & "' AND " & _
                "[Start] <= '" & Format$(DateAdd("d", 1, Date), "mm/dd/yyyy hh:mm AMPM") & "'"
    
    ' フィルタの結果を取得
    Set myItems = myItems.Restrict(strFilter)
    
    Dim apptItem As Outlook.AppointmentItem
    For Each apptItem In myItems
        ' 抽出したアイテムを検索
        Dim reminderTime As Date
        reminderTime = DateAdd("n", -apptItem.ReminderMinutesBeforeStart, apptItem.Start)
        If reminderTime >= DateAdd("h", 12, Date) And reminderTime <= DateAdd("h", 13, Date) Then
            ' リマインダ表示時間が12:00-13:00の間だった場合、リマインダ時間を11:50に変更
            With apptItem
                .ReminderMinutesBeforeStart = DateDiff("n", DateAdd("h", 11, DateAdd("n", 50, Date)), .Start)
                .Save
            End With
        End If
    Next apptItem

End Sub

解説

Application_Startup()

Outlookの起動時に呼び出されるイベントです。

参考にしたサイト

ある期間内の予定のうちで件名に特定の語を含むものを予定表で検索する
[【Outlook VBA】メールや予定をフィルターで検索する]
(https://qiita.com/vicugna-pacos/items/977fd4c32ebe0486869b)