【Excel VBA】複数ユーザのOutlook予定表をExcelから登録・編集する方法!

複数ユーザのOutlookの予定表の予定をまとめて編集したいことはないでしょうか。

そんな中で、

・Outlookから予定を入れるのは面倒…
・Excelにメンバの予定をまとめ、Outlookへ一括登録をする方法ってあるの?

と悩むことがあるかとおもいます。

今回は、そんなお悩みを解決する、

Excel VBAで複数ユーザのOutlook予定表をExcelから登録、編集する方法

についてまとめます!

複数ユーザのOutlook予定表をExcelから追加・編集する方法について

前回、「【Excel VBA】一瞬でExcelワークシートへOutlookの予定表を取り込む方法」をご紹介しましたが、

読者の方から複数ユーザのOutlook予定情報をまとめて編集できないか

ご要望がありましたので、その操作ができるように機能を変更してみました。

タカヒロ
タカヒロ
複数名のスケジュール調整がExcelの1シートで管理できますのでかなり便利です。

 

では機能の説明をしたいと思います。

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

データについてはこれまで1ユーザのみを対象にしていましたが、今回はメールアドレス欄を用意し、そのメールアドレスに該当する複数ユーザを対象にしています。

その対象ユーザに対してExcelからスケジュールの新規登録、変更を行うといった内容となります。

Excelブック(VBA) → このメアドの人の予定を編集してね → Outlook
Excelブック ← メアドの人の予定を変更したよ ← Outlook
①に戻りメンバリスト件数分処理を繰り返す

では早速実装をして動かしてみましょう!

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

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

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

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

③実行アカウントに対して対象者の予定表の編集権限を付与する
マクロを実行するアカウントは対象者の予定が変更できる編集権限を保持している必要がありますので、
対象者の予定表へ編集権限を付与してもらいましょう。

以上です。

VBAを実装する

続いてVBAを実装します。

今回VBAは以下の通りとなります。

VBAは前回の「【Excel VBA】他人のOutlook予定表をExcelから登録、編集する」をベースに、

複数ユーザ分の編集ができるように機能を追加・変更したものとなります。

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 
     
     
    'Excel用の定義 
    Dim wbBook As Workbook 
    Dim wsSheet As Worksheet 
     
    Dim lnContactCount As Long 
     
    'スクリーンの更新は行われません。 
    Application.ScreenUpdating = False 
     
    'Excelのブックとワークシートのオブジェクトを設定します。 
    Set wbBook = ThisWorkbook 
    Set wsSheet1 = wbBook.Worksheets(1) 
     
  
    '操作対象の他人のアドレスを指定 
    strAddress = wsSheet1.Cells(2, 11) 
  
  
     
    '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 
  
    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() 
  
            'もし違うアドレスだったら再セットする。 
            If strAddress <> wsSheet1.Cells(i, 11) Then 
                '操作対象の他人のアドレスを再指定 
                strAddress = wsSheet1.Cells(i, 11) 
                Set recOther = olNamespace.CreateRecipient(strAddress) 
                Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderCalendar) 
                Set olConItems = olFolder.Items 
            End If 
                 
                '更新処理 
                For Each olItemBefor In olConItems 
                    If TypeName(olItemBefor) = "AppointmentItem" Then 
                     
                        'ExcelI列のEntryIDと登録されているEntryIDが一致していたら該当予定表を更新 
                        If olItemBefor.EntryID = wsSheet1.Cells(i, 9) Then 
                         
                            '比較用に一時的に作成 
                            With olItem 
                                .Subject = wsSheet1.Cells(i, 1) 
                                .Start = Format(wsSheet1.Cells(i, 3), "yyyy/mm/dd hh:mm:ss") 
                                .End = Format(wsSheet1.Cells(i, 4), "yyyy/mm/dd hh:mm:ss") 
                            End With 
  
  
                            '登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新 
                            '※更新の条件はご都合に応じて変更してください。この条件が無い場合はExcelの予定表すべて更新されますので、ご注意ください。 
                            If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then 
  
  
                            Else 
                                '定期的な予定である場合は除外 
                                If wsSheet1.Cells(i, 10) <> "True" Then 
                                     With olItemBefor 
                                        .Subject = wsSheet1.Cells(i, 1) 
                                        .Location = wsSheet1.Cells(i, 2) 
                                        .Start = Format(wsSheet1.Cells(i, 3), "yyyy/mm/dd hh:mm:ss") 
                                        .End = Format(wsSheet1.Cells(i, 4), "yyyy/mm/dd hh:mm:ss") 
                                        .Body = wsSheet1.Cells(i, 5) 
                                        .RequiredAttendees = wsSheet1.Cells(i, 6) 
                                        .OptionalAttendees = wsSheet1.Cells(i, 7) 
                                        .Save 
                                    End With 
                                End If 
                            End If 
                             
                                'Null out the variables. 
                                Set olItem = Nothing 
                             
                        End If 
                     
  
                    End If 
                     
                Next 
  
                If wsSheet1.Cells(i, 9) = "" Then 
                    'ExcelI列のEntryIDが登録されていなかったら新規登録 
                    With olItem 
         
                        .Subject = wsSheet1.Cells(i, 1) 
                        .Location = wsSheet1.Cells(i, 2) 
                        .Start = Format(wsSheet1.Cells(i, 3), "yyyy/mm/dd hh:mm:ss") 
                        .End = Format(wsSheet1.Cells(i, 4), "yyyy/mm/dd hh:mm:ss") 
                        .Body = wsSheet1.Cells(i, 5) 
                        .RequiredAttendees = wsSheet1.Cells(i, 6) 
                        .OptionalAttendees = wsSheet1.Cells(i, 7) 
                        .Save 
                   End With 
  
                   'ExcelI列へ発行されたEntryIDを書き込み 
                   wsSheet1.Cells(i, 9) = olItem.EntryID 
                     
                End If 

        Next 
     
    Else 
        MsgBox "処理を中断します" 
    End If 
     
    'Null out the variables. 
    Set olItem = Nothing 
    Set olApp = Nothing 
    Set olConItems = Nothing 
    Set olFolder = Nothing 
    Set olNamespace = Nothing 
    Set wbBook = Nothing 
    Set wsSheet1 = Nothing 
             
    'Turn screen updating back on. 
    Application.ScreenUpdating = True 
     
    MsgBox "Outlook予定表の登録が完了しました!", vbInformation 
     
End Sub 

実装手順は以下の通りです。

今回はExcel側にこのVBAを実装します。

①Excelを新規に開き、「開発」タブをクリックし、「VisualBasic」をクリックします。
もしくはショートカットキー「Alt」+「F11」でもOKです。

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

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

こちらで完了です。

テストデータを準備する

対象者のメールアドレスと予定をExcelへまとめる

今回のマクロはExcel側にまとめた予定表取得対象者のメールアドレスを対象に予定表を登録、編集する処理となるため、

Excel側に対象者のメールアドレスとスケジュールをまとめる必要があります。

K列に対象者のメールアドレス、A列からJ列までスケジュールを入力します。
※「EntryID」は空欄で構いません。

入力が面倒という方は、前回の「【Excel VBA】一瞬で複数ユーザのOutlook予定表をExcelへ取り込む方法!」を参考に既存のスケジュールを取り込むようにしてください。
この場合は既存の予定の変更という形で処理されます。

サンプルでは、既存の予定の変更の形で、以下の予定を、

のようにスケジュールを変更しています。

タカヒロ
タカヒロ
今回は既存予定を変更する処理となりますので、テストユーザ等で十分に検証してから本番稼働させるようにお願いします。

なお、予定表取得対象者のメールアドレスですが、同じドメインに参加しているユーザのメールアドレス
マクロを実行する人は対象者の予定が変更できる権限を保持している必要がありますので、ご注意ください。

こちらで、テストデータの準備は完了です。

VBAを実行する

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

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

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

②「Outlook予定表の取り込みが完了しました!」が表示されたら完了です。

Outlook予定表がExcelの指定通りに変更されたことが確認できましたね!

変更前

変更後

 

さいごに

いかがでしょうか。

今回は

Excel VBAで複数ユーザのOutlook予定表をExcelから登録、編集する方法

についてまとめました。

なお、既存の予定を変更する処理が含まれますので、検証は十分されてから本番稼働するようあらためてお願いいたします。

また、他にも便利な方法がりますので、よろしければご参照頂ければと思います。

Excelの予定一覧から自分のOutlookの予定表へ登録する方法

Excelの予定一覧から他人のOutlook予定表を登録、編集する方法

他人のOutlook予定表をExcelワークシートへ取り込む方法

【Excel VBA】先月、今月、翌月分のOutlook予定表データをワンクリックで取り込む



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

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








20 件のコメント

  • 初めまして。
    大変参考になる記事をありがとうございます。
    ご教示いただきたいことがございまして、質問させていただきたく思います。

    こちらの予定登録を会議出席依頼の形で送りたく、
    タカヒロ様の別記事を参考に、2か所下記に変更しました。
    .Save

    .MeetingStatus = 1
    .Send

    しかしそうすると、最初の1人目までは機能したのですが、
    For Each olItemBefor In olConItems
    のところでオートメーションエラーが出てしまいます。
    こちらどのようにしたら、私からの会議出席依頼の形で複数人の予定を編集できるかご教示いただくこと可能でしょうか。
    なお、予約者・必須出席者・対象者とも、同じメルアドを入力しています。

    お手数おかけいたしますが、何卒よろしくお願いいたします。

  • お世話になっております。
    マクロを運用させることはできたのですが、一点ご質問がございます。
    主催者を自分にせずに参加依頼を送る方法はございますか。
    ご教示いただけますと幸いです。

  • 作成したエクセルファイルを別のエクセルファイルへコピーしマクロを実行すると同じファイルが作成されてしまいます。コピーの仕方が悪いのでしょうか。ご教授頂けると幸いです。よろしくお願い致します。

    • マクロ実行の際にファイルが作成されてしまう現象ですが、
      いろいろ調べたところ「ブックの共有(レガシ)」をオンになっている場合に発生することがわかりました。
      「ブックの共有(レガシ)」がオンになっていないか確認いただき、
      もしそうであればブックの共有を解除頂いた上でマクロを実行頂きたくお願いいたします。

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

      コピーでは設定値や他のマクロがそのまま引き継がれますので、Excelファイルを新規に作成した上でVBAを実装頂けますでしょうか。

      またコードにブレークポイントをいくつか設定し、コードのどの段階でファイルが作成されるかご教示頂けますでしょうか。

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

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

    エクセルファイルでマクロを実行すると、同じシートのエクセルファイルが作成されます。
    作成されたエクセルファイルのシートを更新してからマクロを実行しないと更新した内容が反映されない状況です。
    同じエクセルファイルが作成されることなく、1つのファイルで更新・マクロ実行が出来るようにするにはどのような処理が必要でしょうか。

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

      マクロの実行はできたようですね。
      Excelファイルが新規作成されるということですが、公開コードの中にはその処理はありませんので
      別の要因が考えられます。

      一度新規作成したExcelファイルにVBAとデータをセットして検証いただけますでしょうか。
      もし同じ結果でしたらデバッグしファイルが新規作成されるコードがどこに該当するかご教示頂けますでしょうか。

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

  • はじめまして。
    上記VBAについて下記エラーが出て実行が出来ない状態です。

    Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderCalendar) Set olConItems = olFolder.Items

    どのような原因が考えられますでしょうか。
    ご教授頂ければ幸いです。よろしくお願い致します。

  • 出席者を二人とも任意出席者に設定する方法はございますか。お忙しいところ恐縮ですがご教示いただけますと幸いです。

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

      サンプルの表でH列が任意出席者欄となっておりますので、「;」区切りで2名分のアドレスを指定頂ければと存じます。
      また、既存アイテムを編集する場合は件名、開始日、終了日の変更が必要ですので合わせて変更をお願い致します。

  • はじめまして、いつもお世話になっております。
    恐縮なのですが、今回ご教示いただいている件についてエラーが出てしまうため
    ご教示いただけますと幸甚です。

    事象:VBAを実行する際に『コンパイルエラー:ユーザー定義型は定義されていません』と表示され実行ができません。

    懸念点:『VBAを実装する』の③で右ペインのウインドウにコードをコピペするかと思うのですが、右上の『Outlookの連絡先をインポートする』というタブがなく、『複数の他人のOutlook予定表へ予定を登録する』しか選択できません。
    これが原因ではないかと推測しています。

    ネット等で調べたのですが、タブを作成するやり方がわからずエラーが解決しません。お手数をおかけし恐縮なのですが、ご存じでしたら解決方法を教えていただきたいです。よろしくお願いいたします。

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

      エラー内容から「参照設定」が実施されていない可能性がございます。

      本ページの「Excel VBAからOutlookを操作するための下準備」③項目を参照頂き、
      「Microsoft Outlook XX.X Object Library」にチェックが入っているかご確認頂けますでしょうか。

      なお、タブ『Outlookの連絡先をインポートする』につきましては、以前の記事の画像を流用しているためとなり、
      本機能との関係はございませんこと、ご承知頂きたくお願いいたします。

      • ご回答いただきましてありがとうございます。

        先程、ご指示いただたいた通り確認したところチェックボックスのチェックが
        抜けていました。
        再試行の結果Outlook側に無事反映いたしました。ありがとうございます。
        ただ、自身のメールアドレスの予定はOutlookに反映するのですが、他者のメールアドレス分の予定に関しては他ユーザーアドレス⇒Outlook予定表反映がなされません。

        たびたびのご質問で恐縮なのですが、解消方法をご存じでしたらおしえていただきたく存じます。
        なにとぞよろしくお願いいたします。

        • 無事実行ができたようでよかったです。
          他の方の予定が変更できないことについてですが、貴方のアドレスに対して編集権限がない可能性がありますのでご確認いただけますでしょうか。

          • たびたびご回答をいただきありがとうございます。
            先程確認したところ、ご指摘の通り編集権限の設定をしていなかったためデータが反映しなかったようです。
            お陰様で、無事使えるようになりました。本当にありがとうございました。

  • いつも大変お世話になっております。
    こちらのVBAを利用して、1つの予定の対象者を複数にすることは可能でしょうか?
    すみませんが、ご教授頂ければ幸いです。

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

      1つの予定の対象者を複数にしたい件につきまして、
      対象者とは出席者のことでよろしいでしょうか。

      その場合は
      ***@extan.jp;****@extan.jp
      のように;区切りでアドレスを入力いただければ複数の指定が可能です。

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

  • コメントを残す

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