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

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

その中で他人が共有している予定の一覧を取得した上、

さらにExcelの一覧表からOutlookの予定表を登録、編集できると便利ですよね。

今回はExcel VBAを使い、Excelへ取り込んだ予定表の一覧から、他人のOutlook予定表を登録、編集する方法をご紹介します。



Excelへ取り込んだ予定表の一覧から、他人のOutlook予定表を登録、編集する流れ

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

前回Excelブック側に取り込んだ予定表を使いますので、

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

①②が前回分、今回は③④の部分になります。

Excelブック(VBA) → この人の予定一覧ちょうだい → Outlook
Excelブック ← 予定一覧を出すよ ← Outlook
Excelブック(VBA) → この人のこのスケジュールを更新してね → Outlook
Excelブック ← スケジュールを更新したよ ← Outlook

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


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

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

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

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

以上です。



サンプルの他人の予定一覧を準備する

続いてスケジュールの変更をしたい他人の予定一覧をExcelブック側に用意します。

前回Excelブック側に取り込んだ予定表を使いますので、以下を参照の上用意をしてください。

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

サンプルでは「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 あり、週次開催

Excel側の予定表一覧です。

なお、今回は定期的な予定は仕様により処理対象から外しています。
ご了承ください。



VBAを実装する

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

今回の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の予定表へ登録する()

    '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 checkFlg As Long
    
    '重複チェックフラグ初期値設定
    checkFlg = 0

    '操作対象の他人のアドレスを指定
    Dim strAddress As String
    strAddress = "hanako@extan.jp"
    
    
    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    
    Dim lnContactCount As Long
    
    'スクリーンの更新は行われません。
    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 recOther = olNamespace.CreateRecipient(strAddress)
    Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderCalendar)
    Set olConItems = olFolder.Items
    
    '自分自身のアイテムを更新する場合は以下をアクティブにしてください。
    'Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
    'Set olConItems = olFolder.Items
    
    
    '取得結果を記述する行番号を指定します。2行目のセルから開始されることになります。
    lnContactCount = 2

    Dim rc As Integer
    rc = MsgBox("予定表へ登録しますか?", vbYesNo + vbQuestion, "確認")
    
    If rc = vbYes Then
    
        '予定表一覧の件数分繰り返す。
        For i = lnContactCount To Cells(1, 1).End(xlDown).Row
            Set olItem = olConItems.Add()


                '重複チェック&更新処理
                For Each olItemBefor In olConItems
                    If TypeName(olItemBefor) = "AppointmentItem" Then
                    
                        'エクセルI列の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
                            '登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新します。
                            '※更新の条件はご都合に応じて変更してください。この条件が無い場合はエクセルの予定表すべて更新されますので、ご注意ください。
                            If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then
 

                            Else
                                '定期的な予定でない場合更新します。
                                If Cells(i, 10) = "False" 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, 6)
                                        .OptionalAttendees = Cells(i, 7)
                                        .Save
                                    End With
                                End If
                                
                            End If
                            
                                'Null out the variables.
                                Set olItem = Nothing
                            
                        End If
                    
                    End If
                    
                Next

                If checkFlg <> 1 Then
                    'エクセルI列のEntryIDと登録されているEntryIDが一致していなかったら新規登録します。
                    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, 6)
                        .OptionalAttendees = Cells(i, 7)
                        .Save
                   End With

                   'エクセルI列へ発行されたEntryIDを書き込み
                   Cells(i, 9) = olItem.EntryID
                    
                End If

            
            '重複フラグリセット
            checkFlg = 0

        Next
    
    Else
        MsgBox "処理を中断します"
    End If
    
    'Null out the variables.
    Set olItem = 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を実行する

ExcelからOutlook予定表の単体の予定を変更する

①サンプルではExcel側の件名「Test1」の予定の開始日時を以下のように変更しました。

変更前

件名 場所 開始日時 定期的な予定
Test1 Microsoft Teams 会議 2020/9/1 9:30 FALSE

変更後

件名 場所 開始日時 定期的な予定
Test1 Microsoft Teams 会議 2020/9/1 10:00 FALSE

 

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

①「開発」タブの「VBA」をクリックし「他人のOutlookの予定表へ登録する」を選択し、「実行」をクリックします。

②「Outlook予定表の登録が完了しました!」が表示され、
Outlook予定表が変更されましたね。

変更前

変更後

ExcelからOutlook予定表へ予定を新規追加する

①サンプルではExcel側の件名「Test4」で「EntryID」がの予定を追記しました。

追加

件名 開始日時 終了日時 EntryID 定期的な予定
Test4 2020/9/4 10:00 2020/9/4 11:30 FALSE

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

②「開発」タブの「VBA」をクリックし「他人のOutlookの予定表へ登録する」を選択し、「実行」をクリックします。

③「Outlook予定表の登録が完了しました!」が表示され、
Outlook予定表が変更されました。

変更前

変更後

ExcelからOutlook予定表の複数の予定を変更する

①サンプルではExcel側の件名「Test1」、「Test2」の予定の開始日時を以下のように変更しました。

変更前

件名 開始日時 終了日時 定期的な予定
Test1 2020/9/1 10:00 2020/9/1 10:30 FALSE
Test2 2020/9/2 10:00 2020/9/1 10:30 FALSE
Test4 2020/9/4 10:00 2020/9/4 10:30 FALSE

変更後

件名 開始日時 終了日時 定期的な予定
Test1 2020/9/1 10:00 2020/9/1 11:30 FALSE
Test2 2020/9/2 10:00 2020/9/2 11:30 FALSE
Test4 2020/9/4 10:00 2020/9/4 11:30 FALSE

VBAの実行をしてみましょう。

②「開発」タブの「VBA」をクリックし「他人のOutlookの予定表へ登録する」を選択し、「実行」をクリックします。

②「Outlook予定表の登録が完了しました!」が表示され、
Outlook予定表が変更されました。

変更前

変更後

ExcelからOutlook予定表の予定の件名を変更する

①サンプルではExcel側の件名「Test1」の件名を「Test1 変更」へ変更しました。

件名 開始日時 終了日時 定期的な予定
Test1 変更 2020/9/1 10:00 2020/9/1 11:30 FALSE

VBAの実行をしてみましょう。

②「開発」タブの「VBA」をクリックし「他人のOutlookの予定表へ登録する」を選択し、「実行」をクリックします。

③「Outlook予定表の登録が完了しました!」が表示され、
Outlook予定表が変更されましたね!

 

その他にOutlookの予定表を編集できること

その他にOutlookの予定表を編集できることはまだあります。

場所の変更:サンプルでは空欄ですが、会議場所の変更が行うことができます。TeamsやSkypeなどオンライン会議の場合はOutlook側から指定をするようにお願いします。

予定の本文:本文の内容を変更することができます。

ただし、注意いただきたい点はText形式になってしまうことです。
ハイパーリンクなどHTML形式で保存している場合はText形式に変更されますので、無効化をするようにお願いします。

なお、無効化する場合は以下を
.Body = Cells(i, 5)
コメントアウト
.Body = Cells(i, 5)
してください。

出席者の変更:必須、任意出席者の変更をすることができます。
複数入れる場合は「;」で区切るようにしてください。

今回の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)

自分自身のアイテムを更新する場合は以下をアクティブにしてください。
‘Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
‘Set olConItems = olFolder.Items

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

エクセルI列のEntryIDと登録されているEntryIDが一致していたら該当予定表を更新します。
If olItemBefor.EntryID = Cells(i, 9) Then

登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新します。
※更新の条件はご都合に応じて変更してください。この条件が無い場合はエクセルの予定表すべて更新されますので、ご注意ください。
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, 6)
.OptionalAttendees = Cells(i, 7)

件名:Subject
場所:Location
開始日時:Start
終了日時:End
予定の本文:Body
予約者:Organizer
必須出席者:RequiredAttendees
任意出席者:OptionalAttendees

ここで保存されます。
.Save

エクセルI列のEntryIDと登録されているEntryIDが一致していなかったら新規登録します。
If checkFlg <> 1 Then

新規の場合は発行されたEntryIDをExcelシートのI列へ書き込みます。
Cells(i, 9) = olItem.EntryID

定期的な予定を変更しようとするとエラーとなる理由

定期的な予定を変更しようとすると、

オブジェクトはこのメソッドをサポートしません。

とメッセージが表示され、エラーとなります。

定期的な予定を更新するとエラーとなる理由は

定期的な予定は別のレコードで管理されているからです。

定期的でない予定は1レコードづつ開始日、終了日が登録されていますが、

〇〇日から週に1回などと指定する定期的な予定はパターン登録といい、それぞれの予定の開始日、終了日はパターンから算出したものなのです。

なので、定期的な予定を変更する場合はパターン登録側のレコードを変更する必要があるという訳です。

こちらは別記事で紹介予定ですのでしばらくお待ちください。

 



さいごに

いかがでしょうか。

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

2 件のコメント

  • こちらのVBAを一部利用して他人の予定表へ予定が入ってない状態から新規に入力しようとしているのですが、実行すると自分の予定表に反映されてしまいます。原因として考えられることは何がありますでしょうか。
    Dim strAddress As String
    strAddress = “参照したい先のアドレス”

    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
    ここは入力しており、動作自体は問題なくできております。
    ご教示いただけましたら幸いです。

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

      対象者の既に入っている予定の変更はできるが、新規の場合は自分の予定表へ更新されてしまうという状況でよろしいでしょうか。

      確認頂きたいことは、以下の通りです。
      ・strAddress = “参照したい先のアドレス”
       こちらに予定表を変更したいアドレスが入力されているか確認をお願いします。
      ・貴殿のアカウントに対し、他人の予定表への書き込み権限が付与されているか確認をお願いします。

      ・以下のコメントが外れていないか、また一旦行ごと削除して確認をお願いします。
      ‘自分自身のアイテムを更新する場合は以下をアクティブにしてください。
      ‘Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
      ‘Set olConItems = olFolder.Items

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

  • コメントを残す

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