【VBA】Outlook会議通知の重要度を設定する方法！

VBAでOutlook予定表の会議通知の重要度を設定して送信したいときはないでしょうか。。

そんな中で悩むことことは、

・VBAでOutlook予定表の会議通知の重要度を設定したいが方法がわからなない
・複数の会議出席依頼の重要度をまとめて設定したいが方法がわからない

ではないでしょうか？

今回はそんなお悩みを解決する

Excelにまとめた会議情報からOutlookの会議通知の重要度を設定して送信する方法

についてまとめます！

Excelにまとめた会議情報からOutlookの会議通知の重要度を設定して送信するイメージについて

今回のマクロは前回の記事

【VBA】Excel からOutlookの会議出席依頼を送信する方法！会議変更後の送信も対応！

をベースに、重要度設定機能を拡張したものになります。

実行環境はスケジュール一覧があるExcel側となります。

①Excelブック(VBA) →　予定表へ会議を登録・送信して　→ Outlook
②Excelブック ←　会議を登録・送信したよ　← Outlook

Excelの会議情報一覧があり、

重要度項目も追加し、

Outlookの予定表へ会議を登録

Excel側に設定した重要度の値は反映され

送信する流れとなります。

早速実装をして動かしてみましょう！

Excel VBAからOutlookを操作するための下準備

①まずExcelを起動し、「開発」タブをクリックします。

②VBEの画面が開いたら、メニューから「ツール」>「参照設定」を選択します。

③「Microsoft Outlook XX.X Object Library」を探してチェックボックスにチェックし「OK」をクリックします。

以上です。

VBAを実装する

Excelにまとめた会議情報からOutlookの会議通知の重要度を設定して送信するVBAを実装していきましょう。

コードはは以下の通りとなります。

Sub Outlookから会議通知の重要度を設定して送信する()

    'Outlook用の定義
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Folder
    Dim olConItems As Outlook.Items
    Dim olItem  As AppointmentItem
    Dim olItemBefor  As AppointmentItem
    Dim checkFlg As Long
    
    '重複チェックフラグ初期値設定
    checkFlg = 0

    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim lnContactCount As Long
    
    '抽出期間の定義
    Dim strStart As String
    Dim strEnd As String
    Dim intKikan As Integer
    
    Dim i As Integer

    '対象予定表の抽出期間を月単位で指定します。
    '※抽出期間が短いと予定アイテムのチェックができず登録できない場合がありますので注意してください｡
    intKikan = 12  '抽出期間を12か月にしています。
    
    strStart = Format(DateAdd("m", -intKikan, Date), "yyyy/mm/dd") '抽出するスケジュールの開始日を指定
    strEnd = Format(DateAdd("m", intKikan, Date), "yyyy/mm/dd") '抽出するスケジュールの終了日を指定
    
    
    'スクリーンの更新は行われません。
    Application.ScreenUpdating = False
    
    'Excelのブックとワークシートのオブジェクトを設定します。
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(1)
    
    wsSheet.Activate
    
    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
    Set olConItems = olFolder.Items

    'Restrictメソッドで期間指定して抽出するメールアイテムを絞り込みます。
    Set olConItems = olConItems.Restrict("[Start] >= '" & strStart & "' And [End] < '" & strEnd & "'")


    '取得結果を記述する行番号を指定します。2行目のセルから開始されることになります。
    lnContactCount = 2

    
    If MsgBox("会議出席依頼を送信しますか？", vbYesNo + vbQuestion, "確認") = vbYes Then
    
        '予定表一覧の件数分繰り返します。
        For i = lnContactCount To Cells(1, 1).End(xlDown).Row
            Set olItem = olApp.CreateItem(olAppointmentItem)

            '重複チェック＆更新処理
            For Each olItemBefor In olConItems
                If TypeName(olItemBefor) = "AppointmentItem" Then
                
                    'ExcelI列のEntryIDと登録されているEntryIDが一致していたら該当予定表を更新します。
                    If olItemBefor.EntryID = Cells(i, 9) Then
                    
                        '比較用に一時的に作成
                        With olItem
                            .Subject = Cells(i, 1)
                            .Start = Format(Cells(i, 3), "yyyy/mm/dd hh:mm:ss")
                            .End = Format(Cells(i, 4), "yyyy/mm/dd hh:mm:ss")
                        End With
    
                    
                        '重複フラグ1をセット
                         checkFlg = 1
                    
                        '登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新します。
                        '※更新の条件はご都合に応じて変更してください。この条件が無い場合はExcelの予定表すべて更新されますので、ご注意ください。
                        If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then


                        Else

                            '定期アイテムは除外します。
                            If Not olItemBefor.IsRecurring Then
                                 With olItemBefor
                                    .Subject = Cells(i, 1)
                                    .Location = Cells(i, 2)
                                    .Start = Format(Cells(i, 3), "yyyy/mm/dd hh:mm:ss")
                                    .End = Format(Cells(i, 4), "yyyy/mm/dd hh:mm:ss")
                                    .Body = Cells(i, 5)
                                    .RequiredAttendees = Cells(i, 7)
                                    .OptionalAttendees = Cells(i, 8)
                                    .Recipients.ResolveAll
                                    .Importance = Cells(i, 12)
                                    .MeetingStatus = 1  '予定を "会議" に設定　※「olMeeting」でもOK
                                    .Send  '送信
                                End With
                            End If
                        End If
                    End If
                End If
            Next
            'EntryIDが空かつ、開始日時が空でない場合のみ新規登録します。
            If checkFlg <> 1 And Cells(i, 9) = "" And Cells(i, 3).Text <> "" Then
                With olItem
                    .Subject = Cells(i, 1)
                    .Location = Cells(i, 2)
                    .Start = Format(Cells(i, 3), "yyyy/mm/dd hh:mm:ss")
                    .End = Format(Cells(i, 4), "yyyy/mm/dd hh:mm:ss")
                    .Body = Cells(i, 5)
                    .RequiredAttendees = Cells(i, 7)
                    .OptionalAttendees = Cells(i, 8)
                    .Importance = Cells(i, 12)
                    .Recipients.ResolveAll
                    .MeetingStatus = 1
                    .Send  '送信

               End With
               
               'ExcelI列へ発行されたEntryIDを書き込みをします。
               Cells(i, 9) = olItem.EntryID
               
               'ExcelF列へ予約者を書き込みをします。
               Cells(i, 6) = olItem.Organizer

            End If
    
        '重複フラグリセット
        checkFlg = 0
    
    Next
    
    Else
        MsgBox "処理を中断します"
    End If
    
    'オブジェクトを解放します。
    Set olItem = Nothing
    Set olApp = Nothing
    Set wbBook = Nothing
    Set wsSheet = Nothing
    Set olNamespace = Nothing
    Set olFolder = Nothing
    Set olConItems = Nothing
    Set olItemBefor = Nothing

    'スクリーンの更新をONにします。
    Application.ScreenUpdating = True
    
    MsgBox "会議出席依頼の送信が完了しました！", vbInformation
    
End Sub

実装手順は以下の通りです。今回はExcel側にこのVBAを実装します。
①Excelを新規に開き、「開発」タブをクリックし、「VisualBasic」をクリックします。
もしくはショートカットキー「Alt」＋「F11」でもOKです。

②標準モジュールを追加します。
左ペインのVBAProjectを右クリックし、「挿入」、「標準モジュール」を選択します。

③右ペインのウインドウに上記のマクロを入力します。

こちらで完了です。

会議出席依頼のデータを準備する

会議出席依頼のデータを準備しましょう。

VBAを実装したExcelのシートへ
以下の項目に沿って記入をしていきます。

件名	場所	開始日時	終了日時	予定の本文	予約者	必須出席者	任意出席者	EntryID	定期的な予定	予備	重要度
件名を入力	場所を入力	開始日時を”yyyy/mm/dd hh:mm:ss”形式で入力	終了日時を”yyyy/mm/dd hh:mm:ss”形式で入力	予定の本文を入力	予約者が登録後入ります。空でOKです。	必須出席者のアドレスを入力	任意出席者のアドレスを入力	会議識別子のEntryIDが登録後入ります。空でOKです。	定期的な予定の識別を入力。FALSEとしてください。	空でOKです。	重要度を（2：高、1：中、0：低）で指定します。

タカヒロ

複数の会議出席者を指定する場合は、「;」セミコロンで区切って入力してください。

サンプルでは以下のように入力しています。

VBAを実行し、会議通知の重要度を設定して送信する

メール誤送信予防の設定をする

今回はメールを送信しますが、メール誤送信防止のためにメールが即送信とならない設定をしておきましょう。

①Outlookのオプションを開きます。

②左ペイン詳細設定をクリックします。

③右ペイン送受信＞「接続したら直ちに送信する」のチェックを外し、OKをクリックします。

続いて、VBAを実行してみましょう。

VBAを実行する

①「開発」タブの「マクロ」をクリックします。

②「Outlookから会議通知の重要度を設定して送信する」を選択し、「実行」をクリックします。

③メッセージ「会議出席依頼の送信が完了しました！」が表示されば完成です！

予定用へ会議スケジュールが登録されましたね。

登録した2件の会議内容を確認しましょう。

赤枠の重要度に加え、宛先、件名、本文共にExcel通りに入っていますね！

次に会議出席依頼が送信されているかチェックしてみます。

Outlookの送信トレイを見てみましょう。

はい、左端アイコンの重要度が設定された上、会議出席依頼メールが送信されていることが確認できましたね！

VBAの説明

対象期間を設け、期間を絞ることによりチェック対象の件数が少なくなるので処理時間を短くすることができました。
サンプルでは抽出期間を12か月にしています。

intKikan = 12

抽出するスケジュールの開始日を指定します。

strStart = Format(DateAdd(“m”, -intKikan, Date), “yyyy/mm/dd”)

抽出するスケジュールの終了日を指定します。

strEnd = Format(DateAdd(“m”, intKikan, Date), “yyyy/mm/dd”)

取得したOutlookオブジェクトを取得します。

Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace(“MAPI”)

予定表のリストはolFolderCalendarというメンバーに格納されていますのでそれを指定しています。

Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)

ExcelI列のEntryIDと登録されているEntryIDが一致していたら該当予定表を更新します。

If olItemBefor.EntryID = Cells(i, 9) Then

登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新します。
※更新の条件はご都合に応じて変更してください。この条件が無い場合はExcelの予定表すべて更新されますので、ご注意ください。

If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then

定期的な予定でない場合変更します。

If Cells(i, 10) = “False” Then

Excel側の値を読み込み、予定オブジェクトにセットします。

.Subject = Cells(i, 1)
.Location = Cells(i, 2)
.Start = Format(Cells(i, 3), “yyyy/mm/dd hh:mm:ss”)
.End = Format(Cells(i, 4), “yyyy/mm/dd hh:mm:ss”)
.Body = Cells(i, 5)
.RequiredAttendees = Cells(i, 7)
.OptionalAttendees = Cells(i, 8)
.Importance = Cells(i, 12)

各プロパティの内容については以下の通りです。

プロパティ名	説明
To	To表示名
CC	CC表示名
BCC	BCC表示名
ReceivedTime	受信日時
Subject	件名
Body	本文
.RequiredAttendees	必須出席者
OptionalAttendees	任意出席者
Importance	重要度（2：高、1：中、0：低）
EntryID	EntryID（メールアイテム固有ID）

予定を “会議” に設定します。「olMeeting」でもOKです。

.MeetingStatus = 1

OlMeetingStatusプロパティの値の詳細は以下の通りです。

Name	Value	Description
olMeeting	1	予定が組まれた状態。
olMeetingCanceled	5	予定が取り消された状態。
olMeetingReceived	3	参加要請が受信された状態。
olMeetingReceivedAndCanceled	7	予定されていた会議が取り消されたが、ユーザーの予定表にはまだ表示されている状態。
olNonMeeting	0	参加者なしで予定が組まれた状態。?予定表に休日を設定する際、この状態が生じることがあります。