【VBA】ExcelへOutlookの追加予定表の予定情報を取り込む方法

Outlookの規定以外に追加した予定表に登録されている予定をExcelシートへ取り込み、一覧表にしたいことはないでしょうか。

けど、そんな時に困ることは、

・VBAで追加した予定表からExcelへ予定情報を出力する方法がわからない
・追加した予定表の予定情報を手作業で取り出すことは大変

だと思います。

今回は、そんな困りごとを解決する、

ExcelへOutlookの追加予定表の予定情報を取り込む方法

についてまとめます!

ExcelへOutlookの追加予定表の予定情報を取り込む機能ついて

以前、「【Excel VBA】一瞬でExcelワークシートへOutlookの予定表を取り込む」について紹介した時に、読者さまより追加した予定表からも出力できないかとのコメントがありましたので、

今回は既定の予定表へ追加した予定表からExcelへ予定情報を出力する方法をまとめてみました。

変更箇所は参照元を既定から追加した予定表へ変更したという形になります。

処理フローについて

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

実行することで、Outlookの予定表情報をExcelへ出力する流れとなります。

Excelブック(VBA) → 既定ではなく追加した予定表の情報をちょうだい → Outlook
Excelブック ← 追加した予定表の情報だよ ← Outlook

次に早速実装をして動かしてみましょう!

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

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

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

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

以上です。

VBAを実装する

続いてVBAを実装します。

VBAは以下の通りとなります。
前回の記事「【Excel VBA】一瞬でExcelワークシートへOutlookの予定表を取り込む」に、変更を加えたものになります。

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 olPattern

    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim lnContactCount As Long
    
    '予定表の定義
    Dim strAddress As String
    Dim objAppt As AppointmentItem
    Dim strStart As String
    Dim strEnd As String

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

   
    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 olFolder = olNamespace.GetDefaultFolder(olFolderCalendar).Folders("追加予定表1")
    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

設定してもらいたい箇所は以下の<追加予定表を指定>の箇所です。

追加予定表の表示名を入れるようにしてください。

Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar).Folders("<追加予定表を指定>")

サンプルでは「追加予定表1」を指定しています。

予定表の表示名は、左ペインの個人の予定表のリストか、

フォルダ」タブをクリックし、リボンメニューの「予定表のプロパティ」から確認することができます。

タカヒロ
タカヒロ
Folderオブジェクトの表示名の部分に数字を入れるとインデックス値となります。
例えば「1」と設定した場合は、1番目の追加した予定表を参照する形となります。

Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar).Folders(1)

次に対象予定表の抽出期間を指定します。
変更する場合は以下の日時を”yyyy/mm/dd hh:nn”形式で入力してください。

strStart = Format("2021/2/1 00:00", "yyyy/mm/dd hh:nn")
strEnd = Format("2021/2/23 23:59", "yyyy/mm/dd hh:nn")

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

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

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

こちらで完了です。

VBAを実行する

①予定を登録します。
追加した予定へ予定を登録します。

サンプルでは「【VBA】ExcelからOutlookの追加した予定表へスケジュールを登録する」で登録した情報を対象に取り込みます。

②「開発」タブの「マクロ」をクリックし「Outlookの追加予定表の予定情報を取り込む」を選択し、「実行」をクリックします。

③Outlookの予定表へ登録されたら完成です!

今回のVBAについて説明

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

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

予定表のリストはolFolderCalendarというメンバーに格納されていますのでそれを指定しています。
追加した予定表はそのフォルダごとに分かれて格納されていますので、
追加した予定表の表示名をFoldersオブジェクトの引数に渡すことにより
追加した予定表のオブジェクトを取得することができます。

Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar).Folders("追加予定表1")

なおFoldersオブジェクトの引数に数字のみ指定する場合はインデックス値と判定され、
1であれば1番目の追加予定表が指定される形となります。

Trueで定期的な予定を含むようにします。
定期的な予定を含みたくない場合はFalseを指定してください。

olConItems.IncludeRecurrences = True

Findメソッドで期間指定して抽出するスケジュールを絞り込みます。

Set olItem = olConItems.Find("[End] <= """ & strEnd & """ AND [Start] >= """ & strStart & """")

Findメソッドで検索すると期間範囲外の余計なものまでヒットしてしまうので、再度フィルタリングします。

If olItem.Start >= strStart And olItem.End <= strEnd Then

Excelへ出力します。

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

各値の内容は以下になります。

.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かFalseが入ります。

さいごに

いかがでしょうか。

今回は、

ExcelへOutlookの追加予定表の予定情報を取り込む方法

についてまとめました。

他にもOutlook関連の操作をまとめていますので、よろしければご覧ください。



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

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








3 件のコメント

  • タカヒロ様

    お忙しい中、早々にお教えいただき、ありがとうございます。
    他人の追加予定表の情報を取得できない理由の中の「実行アカウントに対して、他人の追加予定表へのアクセス権が付与されていない」が該当していそうなので、その点を解決してから再度試してみます。どうもありがとうございます。

  • Excel VBAについてほとんどわからない状況なのですが、「【VBA】ExcelへOutlookの追加予定表の予定情報を取り込む方法」 を参考にして、自分のOutlookの追加予定表の予定情報を取り込むことができました。ありがとうございました。

    1点お教えいただきたいのですが、自分以外のメンバーのOutlookの追加予定表の予定情報を取り込む際のマクロをお教えいただけますでしょうか。

    「【Excel VBA】Outlookの他人の予定表をExcelワークシートへ取り込む」のマクロの「 Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderCalendar)」の行の後ろに「.Folders(“追加予定表1”)」を付けてみたのですが、うまく作動しませんでした。

    お忙しいところ大変恐縮ですが、お教えいただければ幸いです。よろしくお願いいたします。

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

      ご質問の他人の追加予定表の情報を取り込む方法ですが、
      ご認識の方法で問題ございません。

      取得できない理由としましては、
       ・実行アカウントに対して、他人の追加予定表へのアクセス権が付与されていない
       ・他人の追加予定表の表示名と指定している値が異なっている
       ・アドレスが間違っている(参加ドメインのAD上に存在しないアドレスを指定しているなど)
       ・取得対象の追加予定表の予定アイテムが0件
      が考えられますので、ご確認いただければと存じます。

  • コメントを残す

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