複数ユーザのOutlookの予定表の予定をまとめて編集したいことはないでしょうか。
そんな中で、
・Excelにメンバの予定をまとめ、Outlookへ一括登録をする方法ってあるの？
と悩むことがあるかとおもいます。
今回は、そんなお悩みを解決する、
Excel VBAで複数ユーザのOutlook予定表をExcelから登録、編集する方法について
まとめます！
もくじ
複数ユーザのOutlook予定表をExcelから追加・編集する方法について
前回、「【Excel VBA】一瞬でExcelワークシートへOutlookの予定表を取り込む方法」をご紹介しましたが、
読者の方から複数ユーザのOutlook予定情報をまとめて編集できないかと
ご要望がありましたので、その操作ができるように機能を変更してみました。
では機能の説明をしたいと思います。
今回のVBAの実装先は、これまでと同様Excelブック側となります。
データについてはこれまで１ユーザのみを対象にしていましたが、今回はメールアドレス欄を用意し、そのメールアドレスに該当する複数ユーザを対象にしています。
その対象ユーザに対して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
'エクセルI列の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
'登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新
'※更新の条件はご都合に応じて変更してください。この条件が無い場合はエクセルの予定表すべて更新されますので、ご注意ください。
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
'エクセルI列の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
'エクセルI列へ発行された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予定表を登録、編集する方法
はじめまして、いつもお世話になっております。
恐縮なのですが、今回ご教示いただいている件についてエラーが出てしまうため
ご教示いただけますと幸甚です。
事象：VBAを実行する際に『コンパイルエラー：ユーザー定義型は定義されていません』と表示され実行ができません。
懸念点：『VBAを実装する』の③で右ペインのウインドウにコードをコピペするかと思うのですが、右上の『Outlookの連絡先をインポートする』というタブがなく、『複数の他人のOutlook予定表へ予定を登録する』しか選択できません。
これが原因ではないかと推測しています。
ネット等で調べたのですが、タブを作成するやり方がわからずエラーが解決しません。お手数をおかけし恐縮なのですが、ご存じでしたら解決方法を教えていただきたいです。よろしくお願いいたします。
いつもご利用ありがとうございます。
エラー内容から「参照設定」が実施されていない可能性がございます。
本ページの「Excel VBAからOutlookを操作するための下準備」③項目を参照頂き、
「Microsoft Outlook XX.X Object Library」にチェックが入っているかご確認頂けますでしょうか。
なお、タブ『Outlookの連絡先をインポートする』につきましては、以前の記事の画像を流用しているためとなり、
本機能との関係はございませんこと、ご承知頂きたくお願いいたします。
ご回答いただきましてありがとうございます。
先程、ご指示いただたいた通り確認したところチェックボックスのチェックが
抜けていました。
再試行の結果Outlook側に無事反映いたしました。ありがとうございます。
ただ、自身のメールアドレスの予定はOutlookに反映するのですが、他者のメールアドレス分の予定に関しては他ユーザーアドレス⇒Outlook予定表反映がなされません。
たびたびのご質問で恐縮なのですが、解消方法をご存じでしたらおしえていただきたく存じます。
なにとぞよろしくお願いいたします。
無事実行ができたようでよかったです。
他の方の予定が変更できないことについてですが、貴方のアドレスに対して編集権限がない可能性がありますのでご確認いただけますでしょうか。
たびたびご回答をいただきありがとうございます。
先程確認したところ、ご指摘の通り編集権限の設定をしていなかったためデータが反映しなかったようです。
お陰様で、無事使えるようになりました。本当にありがとうございました。
いつも大変お世話になっております。
こちらのVBAを利用して、１つの予定の対象者を複数にすることは可能でしょうか？
すみませんが、ご教授頂ければ幸いです。
いつもご利用ありがとうございます。
１つの予定の対象者を複数にしたい件につきまして、
対象者とは出席者のことでよろしいでしょうか。
その場合は
***@extan.jp;****@extan.jp
のように;区切りでアドレスを入力いただければ複数の指定が可能です。
よろしくお願いいたします。