【Excel VBA】Outlookの他人の予定表をExcelワークシートへ取り込む

Outlookの予定表でスケジュール共有を行うことは多いかと思います。

その中で他人が共有している予定の一覧を取得したいことはないでしょうか。

今回はExcel VBAを使い、他人のOutlook予定表から予定一覧をExcelワークシートへ出力する方法をご紹介します。

Outlookの予定一覧をExcelへ出力する流れ

今回のVBAの実装先は、Excelブック側となり、

以下の流れで処理が行われます。

①Excelブック(VBA) →　この人の予定一覧ちょうだい　→ Outlook
②Excelブック ←　予定一覧を出すよ　← Outlook

次ではVBAの実装方法について説明をします。

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

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

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

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

以上です。

他人の予定表へサンプルの予定を登録する

続いてOutlookへサンプルの予定を登録します。

今回は、3点の予定を「hanako@extan.jp」の予定表へ登録しました。

2つは単体の予定で、3つ目は週次の定期的な予定となります。

定期的な予定は以下の設定となっています。

VBAを実装する

続いてExcelのVisual Basic EditorへVBAを実装します。

今回のVBAは「【Excel VBA】一瞬でExcelワークシートへOutlookの予定表を取り込む」をベースに、他人の予定表を取り込められるよう、さらに「定期的な予定」も含むよう改良したものです。

実装にあたり、変更頂きたい箇所は2点です。

・誰の予定表を取得するか、メールアドレスを指定する
対象予定表のアドレスを指定してください。

strAddress = “hanako@extan.jp”

・取得する期間を指定する
対象予定表の抽出期間を指定します。※変更する場合は以下の日付を変更してください。

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

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
    
    '対象予定表のアドレスを指定※予定表を変更するときは以下のアドレスを変更してください。
    strAddress = "hanako@extan.jp"
    
    '対象予定表の抽出期間を指定します。※変更する場合は以下の日付を変更してください。
    strStart = Format("2020/09/1", "yyyy/mm/dd") '抽出するスケジュールの開始日を指定
    strEnd = Format("2020/09/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" '予定のID※編集時にキーとして使用します。
        .Cells(1, 10).Value = "定期的な予定"  '定期的な予定であるかのフラグ。定期的な予定はTrue。

        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.GetSharedDefaultFolder(recOther, olFolderCalendar)
    Set olConItems = olFolder.Items

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

   '開始日でソートします。
   olConItems.Sort "[Start]"
   
   'Trueで定期的な予定を含むようにします。※Falseであると定期的な予定は含まれません。
   olConItems.IncludeRecurrences = True
    
    '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
            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を入力します。

こちらで完了です。

VBAを実行する

①「開発」タブの「VBA」をクリックし「Outlookの他人の予定表をExcelへ取り込む」を選択し、「実行」をクリックします。

②Excelのワークシートに書き込まれたら完成です！

なお、実行にあたり予定登録数が多い場合は処理に時間がかかることがありますのでご注意ください。

今回のVBAについて説明

Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace(“MAPI”)

今回追加したところは、他人のオブジェクトを指定し取得する処理です。
strAddressは上記で設定した他人のアドレスが格納されています。
Set recOther = olNamespace.CreateRecipient(strAddress)

取得した他人のオブジェクトの内、予定表のみ絞り込み再取得します。
予定表のリストはolFolderCalendarというメンバーに格納されていますのでそれを指定しています。
Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderCalendar)

コードではolItemオブジェクトのタイプ名が”AppointmentItem”だった場合に処理を進めるようにして今います。
If TypeName(olItem) = “AppointmentItem” Then

開始日で昇順ソートします。
olConItems.Sort “[Start]”

定期的な予定の出力形式を指定します。
Trueで定期的な予定を含むようにします。Falseであると定期的な予定は含まれません。
olConItems.IncludeRecurrences = True

取得する予定表の項目は以下の通りです。
件名：Subject
場所：Location
開始日時：Start
終了日時：End
予定の本文：Body
予約者：Organizer
必須出席者：RequiredAttendees
任意出席者：OptionalAttendees
EntryID：EntryID
定期的な予定：IsRecurring

「【Excel VBA】一瞬でExcelワークシートへOutlookの予定表を取り込む」の時の項目から、EntryIDと定期的な予定の2点を追加しています。

「EntryID」とは予定のIDで、予定ごとに異なるユニークの値となります。今回は使いませんが、次回編集時にキーとして使用します。

「定期的な予定」は定期的な予定であるかのフラグで定期的な予定はTrue、そうでない場合はFalseとなります。

さいごに

いかがでしょうか。

今回のVBAで他人の予定表を効率よく把握できるので、ぜひ活用いただければと思います。

次回は他人のOutlook予定表へExcelに記載されている予定一覧を登録する方法をご紹介します。

【Excel VBA】他人のOutlook予定表をExcelから登録、編集する