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

Outlookの予定表でスケジュール共有を行うことは多いかと思いますが、データ収集などの目的で他人が共有している予定の一覧を取得したいことはないでしょうか。

ただ、そんなときに悩むことは

・他人のOutlook予定表の予定一覧をExcelシートへ出力する方法がわからない
・VBAを使い他人のOutlook予定表の予定一覧を取得したいが方法がわからない

ですよね。

今回は

Excel VBAを使い、他人のOutlook予定表の予定一覧をExcelシートへ出力する方法

についてまとめます!

他人のOutlook予定表の予定一覧をExcelシートへ出力するイメージ

他人のOutlook予定表の予定一覧をExcelシートへ出力するイメージについて説明をします。

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

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

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

Excel側のVBAに取得したい人のアドレスを指定し、ExcelからVBAを実行すると、

指定した人が共有している予定一覧がポンとExcelへ出力されます!

とても便利ですよね!

早速実装して使ってみましょう!!

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

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

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

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

以上です。

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

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

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

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

件名 場所 開始日時 定期的な予定
Test1 Microsoft Teams 会議 2020/9/1 9:30 なし
Test2 Microsoft Teams 会議 2020/9/2 10:00 なし
Test3 定例 Microsoft Teams 会議 2020/9/3 10:00 あり、週次開催

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

他人のOutlook予定表の予定一覧をExcelシートへ出力するVBA

他人のOutlook予定表の予定一覧をExcelシートへ出力するVBAをExcelのVisual Basic EditorへVBAを実装して使ってみましょう。

VBAコード

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

サンプルコードは以下の通りです。

Sub Outlookの他人の予定表をExcelへ取り込む()

    'Outlook用の定義
    Dim olApp As Outlook.Application
    Dim olNamespace As Outlook.Namespace
    Dim olFolder As Outlook.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

VBAを設定する

変更頂きたい箇所は2点です。

誰の予定表を取得するか、メールアドレスを指定する

対象予定表のアドレスを指定してください。

strAddress = "hanako@extan.jp"

取得する期間を指定する

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

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

VBAを実装する

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

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

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

こちらで完了です。

VBAを実行する

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

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

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

VBAについて説明

今回の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となります。

さいごに

いかがでしょうか。

今回は、

Excel VBAを使い、他人のOutlook予定表から予定一覧をExcelワークシートへ出力する方法

についてまとめました。

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

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

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



この記事の関連キーワード

こちらの記事の関連キーワード一覧です。クリックするとキーワードに関連する記事一覧が閲覧できます。



タカヒロ

タカヒロ
実質無料で読めるExcelVBA本についてまとめました。
もしVBA本購入を検討されていたら、どれだけお得か確かめてみてください。

【¥0】実質無料のExcelVBAおすすめ本25選!初級~中級まで網羅!

20 件のコメント

  • ご回答ありがとうございます。
    アクセス権のところに私の名前を対象者に追加してもらい、アクセス許可レベルを「参照者」としてもらうことで、対象者のスケジュールをExcelに取り込むことができました。

  • とても便利なツールを公開して頂きまして、ありがとうございます。

    他人の予定を取得するために以下を実行したのですが、olFolderにオブジェクトが取得できませんでした。(自分のメールアドレスだとolFolder に”予定表”が正しく取得できています)
    Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderCalendar)

    過去の質疑をみると参照の権限が必要ということでしたので、対象者のアクセス権を見てみました。すると「既定」のアクセス許可レベルは「空き時間情報」となっていました。なので参照の権限は付与されていると考えたのですが、その理解で合っていますでしょうか。それともより強い権限(参照者など)にする必要があるのでしょうか?

    • いつもご利用ありがとうございます。

      他人の予定オブジェクトが取得できない件につきまして、
      ご認識の通りアクセス許可レベルが限定的になっていることが原因となっております。

      GetSharedDefaultFolderメソッドの仕様上、予定表フォルダごと情報を取得しますので、参照できないプロパティが含まれているとエラーとなります。

      対応としましては、実行アカウントに対し「すべての詳細を表示可能」以上の権限を付与いただくようお願いいたします。

  • 便利なツールの公開をいただき、ありがとうございます。
    本ツールのコードをコピーして実行したところ、下記の部分でエラーが発生します。

    「 ‘開始日でソートします。
    olConItems.Sort “[Start]”」

    エラー内容は、「実行時エラー’-2147352567(80020009)’: “Start”は不明なプロパティです」というものです。原因がお分かりになりますでしょうか。
    なお、ダウンロードしたい対象アドレスに間違いはございません。

    • いつもご利用ありがとうございます。

      ソートの箇所でエラーとなる件につきまして、
      予定アイテムが正常に取得できていない可能性がありますので、
      まずは、実行アカウントに対して取得先の予定を参照できる権限が付与されているか
      ご確認の程お願いいたします。

      また、併せてご自身のアカウントを設定し、正常に予定アイテムが取得できるか
      ご確認をお願い致します。

  • 遅くなり申し訳ありません。
    エラーになる時にエラーログを取るのも有効ですネ。
    検討します。
    ありがとうございました。

  • エラーが発生する部分に「 On Error Resume Next 」を入れて、エラーを回避する事が出来ました。
    お騒がせしました。

    On Error Resume Next

    olConItems.Sort “[Start]”

    If Err.Number 0 Then
    MsgBox “エラーのときの処理”
    Else
    MsgBox “成功したときの処理”
    End If

    • 解消されたようでよかったです。

      「 On Error Resume Next 」を使用する場合はエラーログを記録し、
      あとで確認できるようにしておくとよいかもしれません。

      よろしくお願いいたします。

  • 始めまして。
    このツールを利用して、グループ内(20人程)で全員の予定表を共有するツールを作っています。
    今後、各自のOUTLOOK予定表アクセス権設定をしながら利用出来る様に改造しようと思っています。
    OUTLOOK予定表アクセス権が出来ているか、事前に分かる処理が分かれば教えて貰えませんか。
    宜しくお願いします。

    以下のようにして、アクセス権判定したいと作ったところ、アクセス権の在り・無しのメンバーとも、
    「 TRUE 」なるので、アクセス権判定出来ませんでした。
    Set recOther = olNamespace.CreateRecipient(mailAddress)
    recOther.Resolve
    If recOther.Resolved Then
    MsgBox “アクセス権在り”
    Else
    MsgBox “アクセス権無し”
    End If

    • いつもご利用ありがとうございます。

      アクセス権判定が総じて「 TRUE 」になることについてですが、
      匿名(Anonymous)や所属しているグループに対して参照権限が付与されているか、
      タイトルや詳細は見れないものの時間枠だけ見れる権限が割り当てられている(Exchangeのデフォルト設定)可能性がありますので、
      今一度対象予定表に対しどのような権限構成となっているか確認頂けますでしょうか。

      よろしくお願いいたします。

  • 職場(o365環境)で自分や他人の予定を吐き出したいと思い、公開頂いているコードを試したのですが、1行目の項目が生成された後、何も抽出されないまま「完了しました!」が出てしまいます。o365環境(クラウド)では使えないなどございますか?

    • いつもご利用ありがとうございます。

      o365環境にて他の方の予定表が取得できない件につきまして、
      まずこちらのo365環境(Exchange Online)にて確認したところ問題はございませんでした。

      原因として考えられるのは指定期間内に予定アイテムが存在しないか、対象者予定表の参照権限が付与されていない等になります。
      お手数ですが、対象者予定表の予定アイテム有無とアクセス権をご確認頂けますでしょうか。

      またご自身のアドレスを指定して予定が取得できるか、併せてご確認頂きたくお願いいたします。

  • 初めまして。
    本サイトを参照して、コードをいれたところ、下記で「コンパイルエラー:ユーザ定義型は定義されていません。」というエラーが出ます。
    どのように対処したらよろしいでしょうか。

    ‘Outlook用の定義
    Dim olApp As Outlook.Application

    • いつもご利用ありがとうございます。

      おそらくOutlook Object Libraryの参照設定が行われていないために、Outlook.Applicationが存在していない扱いになっているかと存じますので、

      本ページの「Excel VBAからOutlookを操作するための下準備」を参考にOutlook Object Libraryの参照設定がされているか確認頂けますでしょうか。

  • いつも参考にさせていただいています
    > Dim olFolder As Folder
    ここですが、環境によっては動作しないようです
    Outlook.Folder
    で定義したら上手く行くようになりましたが問題ないでしょうか?

    • ご連絡ありがとうございます。

      Outlook.FolderではOutlookのフォルダーに限定される形となりますが、
      本内容ではその範囲にあるため問題はございません。

      よろしくお願いいたします。

  • 便利な物を公開して頂いてありがとうございます。
    個人用のメールボックスの予定表は取り込めたのですが、
    備品用メールボックス(共有メールボックス・配布グループ)はエラーになります。
    備品用メールボックス用の予定表を取り込む事は可能でしょうか。
    可能であれば公開していただけると幸いです。
    宜しくお願いします。

    • いつもご利用ありがとうございます。

      ご質問の備品用メールボックス(共有メールボックス・配布グループ)指定の際にエラーとなる件ですが、

      共有メールボックスを指定する場合、共有メールボックス名(AD上の「名前」の部分)、もしくは共有メールボックスに割り当てられているアドレス(AD上の「電子メールアドレス」の部分)を指定し、再度確認頂けますでしょうか。

      よろしくお願いいたします。

      • 返信をありがとうございます。
        下記の3つを行いましたがエラー(Outlookで認識できない名前があります。)になります。

        strAddress = “r-B20-1F-test3@***.co.jp”
        strAddress = “マイクロスコープ_6000(テスト)”
        strAddress = “r-B20-1F-test3”

        エラー画面のデバッグをクリックすると下のolFolderがNothingになっています。
        Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderCalendar)

        宜しくお願いします。

        • ご連絡ありがとうございます。

          Outlook側で認識できない名前ということですが、その場合はGetSharedDefaultFolderメソッドで取得することはできません。※参加しているドメインと同一でOutlookから認識できることが前提となります。
          また、配布グループにはメールボックスという実体(予定表、仕事、メモ等)を持っていないため、配布グループを指定している場合も同様に取得することはできませんので、
          併せてご了承頂きたくお願いいたします。

  • コメントを残す

    メールアドレスが公開されることはありません。 * が付いている欄は必須項目です