【VBA】他人のOutlook予定表へExcelから登録、編集、代理送信する方法

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

そんな中で困ることは、

ですね。

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

さらに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つ目は週次の定期的な予定となります。

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
                    
                        'ExcelI列の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
                            '登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新します。
                            '※更新の条件はご都合に応じて変更してください。この条件が無い場合はExcelの予定表すべて更新されますので、ご注意ください。
                            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
                    'ExcelI列の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

                   'ExcelI列へ発行された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」の予定の開始日時を以下のように変更しました。

変更前

変更後

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

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

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

変更前

変更後

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

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

追加

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

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

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

変更前

変更後

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

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

変更前

変更後

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

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

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

変更前

変更後

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

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

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

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

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

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

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

会議場所の変更

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

予定の本文の変更

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

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

なお、無効化する場合は以下を

コメントアウト

してください。

会議出席者の変更

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

今回のVBAについて説明

Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。

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

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

自分自身のアイテムを更新する場合は以下をアクティブにしてください。

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

ExcelI列のEntryIDと登録されているEntryIDが一致していたら該当予定表を更新します。

登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新します。
※更新の条件はご都合に応じて変更してください。この条件が無い場合はExcelの予定表すべて更新されますので、ご注意ください。

定期的な予定でない場合変更します。

Excel側の値を読み込み、予定オブジェクトにセットします。

ここで保存されます。

ExcelI列のEntryIDと登録されているEntryIDが一致していなかったら新規登録します。

新規の場合は発行されたEntryIDをExcelシートのI列へ書き込みます。

代理人として会議出席依頼を送信する場合の設定

現在予定表へ会議の予定アイテムを保存する設定となっています。

代理人として会議出席者へ出席依頼を送信する場合は、以下コードの

を

へ変更します。

タカヒロ

ソースコード中の変更箇所は2か所となりますので、ご注意ください。

MeetingStatusプロパティの設定値は以下の通りです。
1及び「olMeeting」を指定すると、会議メールとして扱われます。

参考：https://docs.microsoft.com/ja-jp/office/vba/api/outlook.olmeetingstatus

また、代理人送信できるよう、
実行アカウントに対して編集以上のアクセス権の許可をするようにしてください。

タカヒロ

実際にメールが送信されますので、十分検証を行うことを推奨します。

他人の予定表の追加した予定表を指定し登録、編集する

他人の予定表の中で追加した予定表を指定して登録、編集することもできます。

コードの、

へ

を追加します。

例えば、指定アカウントの追加予定表が「追加予定表1」である場合は、

となります。

また、実行アカウントに対して編集以上のアクセス権の許可をするようにしてください。

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

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

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

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

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

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

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

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

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

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

さいごに

いかがでしょうか。

今回は、

についてまとめました。

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