【VBA】Outlook会議の出欠状況をExcelへエクスポートする方法！

Outlookから会議出席依頼をした各会議の出欠状況を一覧化してみたいことはないでしょうか。

例えばセミナーの出席者調整や、部下の面談の日程調整など、
対象者と会議回数が多いケースです。

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

・Outlookから各会議の出欠を確認するのは面倒…
・Excelに会議の出欠状況を取り込みたいけど、どうすればいいの？

ではないでしょうか。

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

・VBAでOutlook会議の出欠状況をExcelへエクスポートする方法

についてまとめます！

Outlook会議の出欠状況をExcelへエクスポートする方法について

前回、「【Excel VBA】一瞬でExcelワークシートへOutlookの予定表を取り込む」をご紹介しましたが、

読者の方から会議の出欠状況もエキスポートできないかと

ご要望がありましたので、会議出席依頼の応答結果をエクスポートし、会議ごとに出欠の集計をする機能を追加したものとなっています。

タカヒロ

前回のVBAと仕組みは似ているものの、互換性はないので、出欠確認用として切り分けて利用いただければと思います。

では機能の説明をしたいと思います。

VBAのプロシージャは2個に分かれています。

一つ目が「Outlook予定の出欠状況を取り込む」で、Outlookの受信トレイにある会議出席依頼の応答結果をExcelへ取り込む機能となります。

2つ目が「Outlook予定表をExcelへ取り込み出欠確認をする」で、対象期間の会議を取り込み、1つ目で取り込んだデータをもとに会議ごとに出欠の集計をする機能となります。

ですので、データ取り込みの際は2つのプロシージャをそれぞれ実行する必要があります。

フロートしては以下の通りです。

①Excelブック(VBA) →　受信している会議出席依頼の応答結果をちょうだい　→ Outlook
②Excelブック ←　会議出席依頼の応答結果をわたすよ　← Outlook
③Excelブック(VBA) →　この期間分の会議リストをちょうだい　→ Outlook
④Excelブック ←　会議リストをわたすよ　← Outlook
⑤Excelブック(VBA)　出欠状況を集計するね
⑥完了

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

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

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

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

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

以上です。

VBAを実装する

続いて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 MailItem
    Dim recOther As Recipient
    Dim objAppt As AppointmentItem
    Dim strStart As String
    Dim strEnd As String

    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim lnContactCount As Long


    'スクリーンの更新は行われません。
    Application.ScreenUpdating = False

    'Excelのブックとワークシートのオブジェクトを設定します。
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(2)

    '書き込み先のセルを指定します。また1行目にタイトルを記述します。
    With wsSheet
        .Range("A1").CurrentRegion.Clear
        .Cells(1, 1).Value = "件名"
        .Cells(1, 2).Value = "クラス"
        .Cells(1, 3).Value = "受信日時"
        .Cells(1, 4).Value = "作成日時"
        .Cells(1, 5).Value = "本文"
        .Cells(1, 6).Value = "送信者メアド"
        .Cells(1, 7).Value = "会議タイトル"
        .Cells(1, 8).Value = "会議ID"
        .Cells(1, 9).Value = "EntryID"
  
        With .Range("A1:Z1")
            .Font.Bold = True
            .Font.ColorIndex = 10
            .Font.Size = 11
        End With
    End With

    wsSheet.Activate

    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    Set recOther = olNamespace.CreateRecipient(strAddress)
    Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
    Set olConItems = olFolder.Items
   'Set olConItems = olFolder.Folders("＜サブフォルダー名＞").Items　'サブフォルダを設けている場合はこちらに差し替えてください。
    

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

    strStart = Format("2020/9/1", "yyyy/mm/dd") '抽出するメールの開始日を指定します。
    strEnd = Format("2020/9/30", "yyyy/mm/dd")  '抽出するメールの終了日を指定します。
    strEnd = DateAdd("d", 1, strEnd)   ' 1日追加
  
    'Restrictメソッドで期間指定して抽出するメールアイテムを絞り込む
    Set olConItems = olConItems.Restrict("[ReceivedTime] >= '" & strStart & "' And [ReceivedTime] < '" & strEnd & "'")

    For Each olItemBefor In olConItems
        With olItemBefor
            'https://docs.microsoft.com/ja-jp/dotnet/api/microsoft.office.interop.outlook.olobjectclass?view=outlook-pia
            'クラス43（通常の受信メール以外）を抽出します。
            If .Class <> "43" Then
                Cells(lnContactCount, 1).Value = .Subject
                Cells(lnContactCount, 2).Value = .Class
                Cells(lnContactCount, 3).Value = .ReceivedTime
                Cells(lnContactCount, 4).Value = .CreationTime
                Cells(lnContactCount, 5).Value = .Body
                Cells(lnContactCount, 6).Value = .SenderEmailAddress
                Cells(lnContactCount, 7).Value = .ConversationTopic
                Cells(lnContactCount, 8).Value = .ConversationID
                Cells(lnContactCount, 9).Value = .EntryID
            
                lnContactCount = lnContactCount + 1
            End If
        End With
    Next
  

    'Null out the variables.
    Set olItem = Nothing
    Set olConItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing

        
    'Turn screen updating back on.
    Application.ScreenUpdating = True
    
    MsgBox "Outlook予定出欠メールの取り込みが完了しました！", vbInformation

End Sub

Sub Outlook予定表をExcelへ取り込み出欠確認をする()
  
    'Outlook用の定義
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Folder
    Dim olConItems As Outlook.Items
    Dim olItem  As AppointmentItem
  
    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim lnContactCount As Long

    '予定表の定義
    Dim strAddress As String
    Dim recOther As Recipient
    Dim objAppt As AppointmentItem
    Dim strStart As String
    Dim strEnd As String



    '対象予定表の抽出期間を指定します。※変更する場合は以下の日付を変更してください。
    strStart = Format("2020/9/1", "yyyy/mm/dd") '抽出するスケジュールの開始日を指定
    strEnd = Format("2020/9/30", "yyyy/mm/dd")  '抽出するスケジュールの終了日を指定

    strEnd = DateAdd("d", 1, strEnd)   ' 1日追加
    
    Dim strDummy As String

    '処理速度優先のためスクリーンの更新は行われません。
    Application.ScreenUpdating = False

    'Excelのブックとワークシートのオブジェクトを設定します。
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(1)
    

    '書き込み先のセルを指定します。また1行目にタイトルを記述します。
    With wsSheet
        .Range("A1").CurrentRegion.Clear
        .Cells(1, 1).Value = "件名"
        .Cells(1, 2).Value = "場所"
        .Cells(1, 3).Value = "開始日時"
        .Cells(1, 4).Value = "終了日時"
        .Cells(1, 5).Value = "予定の本文"
        .Cells(1, 6).Value = "予約者"
        .Cells(1, 7).Value = "必須出席者"
        .Cells(1, 8).Value = "任意出席者"
        .Cells(1, 9).Value = "EntryID"
        .Cells(1, 10).Value = "定期的な予定"
        .Cells(1, 11).Value = "会議ID"
        .Cells(1, 12).Value = "出欠：出席"
        .Cells(1, 13).Value = "出欠：欠席"
        .Cells(1, 14).Value = "出欠：仮承諾"
        .Cells(1, 15).Value = "必須出席者数"
        .Cells(1, 16).Value = "任意出席者数"
  
        With .Range("A1:Z1")
            .Font.Bold = True
            .Font.ColorIndex = 10
            .Font.Size = 11
        End With
    End With

    wsSheet.Activate

    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
    Set olApp = New Outlook.Application
    Set olNamespace = olApp.GetNamespace("MAPI")
    '他人のオブジェクトを指定し取得します。
    Set recOther = olNamespace.CreateRecipient(strAddress)
    '取得した他人のオブジェクトの内、予定表のみ絞り込み再取得します。
    Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
    Set olConItems = olFolder.Items
  

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

  
   '開始日でソートします。
   olConItems.Sort "[Start]"
    
   '定期的な予定を含まないようにします。※Trueにすると定期的な予定はConversationIDがないアイテムがあるためエラーとなります。
   olConItems.IncludeRecurrences = False

    'Findメソッドで期間指定して抽出するスケジュールを絞り込みます。
    Set olItem = olConItems.Find("[End] < """ & strEnd & """ AND [Start] >= """ & strStart & """")

    While TypeName(olItem) = "AppointmentItem"
        'Findで検索すると期間範囲外の余計なものまでヒットしてしまうので、再度フィルタリングします。
        If olItem.Start >= strStart And olItem.End < strEnd Then
            With olItem
                Cells(lnContactCount, 1).Value = .Subject
                Cells(lnContactCount, 2).Value = .Location
                Cells(lnContactCount, 3).Value = .Start
                Cells(lnContactCount, 4).Value = .End
                Cells(lnContactCount, 5).Value = .Body
                Cells(lnContactCount, 6).Value = .Organizer
                Cells(lnContactCount, 7).Value = .RequiredAttendees
                Cells(lnContactCount, 8).Value = .OptionalAttendees
                Cells(lnContactCount, 9).Value = .EntryID
                Cells(lnContactCount, 10).Value = .IsRecurring
                Cells(lnContactCount, 11) = .ConversationID
                Cells(lnContactCount, 12) = "=COUNTIFS(出欠メール一覧!H:H,K" & lnContactCount & ",出欠メール一覧!B:B,""56"")"
                Cells(lnContactCount, 13) = "=COUNTIFS(出欠メール一覧!H:H,K" & lnContactCount & ",出欠メール一覧!B:B,""55"")"
                Cells(lnContactCount, 14) = "=COUNTIFS(出欠メール一覧!H:H,K" & lnContactCount & ",出欠メール一覧!B:B,""57"")"
                Cells(lnContactCount, 15).Value = UBound(Split(.RequiredAttendees, ";")) + 1
                Cells(lnContactCount, 16).Value = UBound(Split(.OptionalAttendees, ";")) + 1
            
            
            End With
            lnContactCount = lnContactCount + 1
        End If
        Set olItem = olConItems.FindNext
    Wend

    'Null out the variables.
    Set olItem = Nothing
    Set olConItems = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
  
    'Turn screen updating back on.
    Application.ScreenUpdating = True

    MsgBox "Outlook予定表の取り込みが完了しました！", vbInformation

End Sub

実装手順は以下の通りです。

今回はExcel側にこのVBAを実装します。

①Excelを新規に開き、「開発」タブをクリックし、「VisualBasic」をクリックします。
もしくはショートカットキー「Alt」＋「F11」でもOKです。

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

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

こちらで完了です。

テストデータを準備する

会議出席依頼の応答結果を用意する

今回のマクロはOutlook受信トレイの会議出席依頼の応答結果を収集しますので、それがあるか確認をします。

テストで準備する場合はダミー会議を設定した上、出席依頼を行い、出席者から出席、欠席、仮承諾の3パターンのメールを得るようにしてください。

サンプルでは、以下の予定を組み、出席者から応答をしてもらいました。

なお、定期的な会議は仕様により処理対象外となりますので、ご了承ください。

タカヒロ

マスタ以外の定期的な会議はキーとなるConversationIDを保持していないため、出欠確認メールとの突合せができず今回は処理から除外しました。

Excelのシートを２つ用意する

今回2つのデータを利用して出席確認状況の集計をおこないますので、
Excelのシートを2つ用意するようお願いします。

一つ目のシート名は任意の名前で結構ですが、
2つ目のシートは「出欠メール一覧」と入れるようにお願いいます。

1つ目のシートに会議一覧、2つ目のシートに出欠メール一覧が入り、一つ目のシートで出欠状況が確認できます。

会議と出欠確認メールの抽出期間を設定する

「Outlook予定の出欠状況を取り込む」、「Outlook予定表をExcelへ取り込み出欠確認をする」プロシージャの
以下のコードを環境にあわせて変更をするようにお願いします。

strStart = Format(“2020/9/1“, “yyyy/mm/dd”) ‘抽出するスケジュールの開始日を指定
strEnd = Format(“2020/9/30“, “yyyy/mm/dd”) ‘抽出するスケジュールの終了日を指定

こちらで、テストの準備は完了です。

VBAを実行する

ExcelからOutlook予定の出欠状況を取り込む

では早速VBAの実行をしてみましょう。

①「開発」タブの「VBA」をクリックし「Outlook予定の出欠状況を取り込む」を選択し、「実行」をクリックします。

②「Outlook予定出欠メールの取り込みが完了しました！」が表示されたら完了です。

2つ目のシート「出欠メール一覧」をみるとデータが入っていますね。

ExcelからOutlook予定表をExcelへ取り込み出欠確認をする

①次に「Outlook予定表をExcelへ取り込み出欠確認をする」を選択し、「実行」をクリックします。

②「Outlook予定出欠メールの取り込みが完了しました！」が表示されたら完了です。
1つ目のシートに会議が入っていることが確認できました。

③出欠状況を確認する
続いて、一つ目のシートを右にスライドしましょう。

L列以降に出欠状況が集計されていますね！

タカヒロ

なお、4行目の定期的な会議で出席者より多くカウントされていますが、それは複製された定期的な会議分もマスタ側で集計がされてしまうためとなります。

機能の説明

今回変更した箇所について説明をします。

「Outlook予定の出欠状況を取り込む」の変更箇所

一つ目が「Outlook予定の出欠状況を取り込む」について、
取得するデータの項目に、”クラス“、”会議タイトル“、”会議ID“を追加しています。

.Range(“A1”).CurrentRegion.Clear
.Cells(1, 1).Value = “件名”
.Cells(1, 2).Value = “クラス”
.Cells(1, 3).Value = “受信日時”
.Cells(1, 4).Value = “作成日時”
.Cells(1, 5).Value = “本文”
.Cells(1, 6).Value = “送信者メアド”
.Cells(1, 7).Value = “会議タイトル”
.Cells(1, 8).Value = “会議ID”
.Cells(1, 9).Value = “EntryID”

“クラス”というのは、OlObjectClassといい、Outlookオブジェクトクラスを表す定数となっています。

定数の内訳は以下をご参照ください。
参考：https://docs.microsoft.com/ja-jp/dotnet/api/microsoft.office.interop.outlook.olobjectclass?view=outlook-pia

今回使う定数は以下の通りです。
・会議辞退：55
・会議承諾：56
・会議仮承諾：57

Outlookからのデータ取得の際には定数しかデータが載らないので、集計時に上記パターンで分類していきます。

ちなみに定数：43は標準の受信メールで、アイコンがメールアイコンのアイテムが該当します。

集計の際に標準の受信メールは不要であるため、以下の条件式で除外をしています。
If .Class <> “43” Then

次に”会議ID”ですが、正確にはConversationIDといい直訳すれば会話IDとかになるのですが、わかりやすくするために言い換えています。

このConversationIDはこのメールアイテムがどの会議に対して紐づくかというキーとしての役割があり、会議側にも同じくConversationIDを保有しています。

出欠メールが保有いているConversationIDをみて、どの会議のコメントであるか、集計の時に利用するというわけです。

なお、以前編集で利用したEntryIDは会議アイテムそのものを示すものに対して、ConversationIDは会議とそれに関連する出欠などのメールアイテムを関連付けるための役割となり、まったく別ものであることに注意してください。