Outlookの予定表で既定の予定表に追加した予定表へスケジュールを一括で登録したいときはないでしょうか。
けど、そんな時に困ることは、
・ExcelでまとめたスケジュールをOutlookに一括登録するにはどうすればよい？
だと思います。
今回は、そんな困りごとを解決する、
Excelにまとめたスケジュール一覧をOutlookの追加した予定表へ一括登録する方法について
まとめます！
もくじ
Excelにまとめたスケジュール一覧をOutlookの予定表へ一括登録する機能ついて
以前、「【Excel VBA】一瞬でExcelワークシートからOutlookの予定表へスケジュールを登録する」について紹介した時に、読者の方より追加した予定表へ登録できないかとのコメントがありましたので、
今回は既定の予定表へ追加した予定表の方への登録について取りまとめてみました。
変更箇所は予定の登録先を既定から追加した予定表へ変更したという点になります。
正しいやり方かどうかわかりませんので、十分検証を頂ければと思います。
今回のマクロ実行環境はスケジュール一覧があるExcel側となります。
実行することで、Excelのスケジュールデータを一件づつ取り出しOutlookの予定表へ登録する流れとなります。
①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 checkFlg As Long
'追加した予定表の異動時に使用するオブジェクト
Dim olItemMove As Object
'重複チェックフラグ初期値設定
checkFlg = 0
'Excel用の定義
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lnContactCount As Long
'抽出期間の定義
Dim strStart As String
Dim strEnd As String
Dim intKikan As Integer
'対象予定表の抽出期間を月単位で指定します。
'※抽出期間が短いと予定アイテムのチェックができず登録できない場合がありますので注意してください｡
intKikan = 12 '抽出期間を12か月にしています。
strStart = Format(DateAdd("m", -intKikan, Date), "yyyy/mm/dd") '抽出するスケジュールの開始日を指定
strEnd = Format(DateAdd("m", intKikan, Date), "yyyy/mm/dd") '抽出するスケジュールの終了日を指定
'スクリーンの更新は行われません。
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 olFolder = olNamespace.GetDefaultFolder(olFolderCalendar).Folders("追加予定表1")
Set olConItems = olFolder.Items
'Restrictメソッドで期間指定して抽出するメールアイテムを絞り込む
Set olConItems = olConItems.Restrict("[Start] >= '" & strStart & "' And [End] < '" & strEnd & "'")
'取得結果を記述する行番号を指定します。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 = olApp.CreateItem(olAppointmentItem)
'重複チェック＆更新処理
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) <> "True" 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, 7)
.OptionalAttendees = Cells(i, 8)
.Save
End With
End If
End If
'Null out the variables.
Set olItem = Nothing
End If
End If
Next
'EntryIDが空である場合のみ新規登録をすることにしました。
If checkFlg <> 1 And Cells(i, 9) = "" Then
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, 7)
.OptionalAttendees = Cells(i, 8)
End With
'追加した予定表へアイテムを移動します。
Set olItemMove = olItem.Move(olFolder)
'ExcelI列へ発行されたEntryIDを書き込み
Cells(i, 9) = olItemMove.EntryID
End If
'重複フラグリセット
checkFlg = 0
Next
Else
MsgBox "処理を中断します"
End If
'Null out the variables.
Set olItem = Nothing
Set olApp = Nothing
Set wbBook = Nothing
Set wsSheet = Nothing
Set olNamespace = Nothing
Set olFolder = Nothing
Set olConItems = Nothing
'Turn screen updating back on.
Application.ScreenUpdating = True
MsgBox "Outlook予定表の登録が完了しました！", vbInformation
End Sub設定してもらいたい箇所は以下の＜追加予定表を指定＞の箇所です。
追加予定表の表示名を入れるようにしてください。
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar).Folders(“＜追加予定表を指定＞“)
サンプルでは「追加予定表1」を指定しています。
予定表の表示名は、左ペインの個人の予定表のリストか、
「フォルダ」タブをクリックし、リボンメニューの「予定表のプロパティ」から確認することができます。
例えば「1」と設定した場合は、1番目の追加した予定表を参照する形となります。
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar).Folders(1)
実装手順は以下の通りです。今回はExcel側にこのVBAを実装します。
①Excelを新規に開き、「開発」タブをクリックし、「VisualBasic」をクリックします。
もしくはショートカットキー「Alt」＋「F11」でもOKです。
②標準モジュールを追加します。
左ペインのVBAProjectを右クリックし、「挿入」、「標準モジュール」を選択します。
③右ペインのウインドウに上記のマクロを入力します。
こちらで完了です。
VBAを実行する
①データを準備します。
サンプルではA列に件名、C、D列に開始日時、終了日時、K列に追加した予定表名を入れています。
手動で入力する際には以下の項目に沿って記入をしてください。
| 件名 | 場所 | 開始日時 | 終了日時 | 予定の本文 | 必須出席者 | 任意出席者 |
| 件名を入力 | 場所を入力 | 開始日時を”yyyy/mm/dd hh:mm:ss”形式で入力 | 終了日時を”yyyy/mm/dd hh:mm:ss”形式で入力 | 予定の本文を入力 | 必須出席者のアドレスを入力 | 任意出席者のアドレスを入力 |
以下の手順を参照頂くと、データ出力できるのでサンプルが楽に準備できます。
【VBA】ExcelへOutlookの追加予定表の予定情報を取り込む方法
②「開発」タブの「マクロ」をクリックし「Outlookの追加した予定表へ予定を登録する」を選択し、「実行」をクリックします。
③Outlookの予定表へ登録されたら完成です！
別の追加した予定表へ登録する
次に別の追加した予定表へ登録をしてみましょう。
2つ目に追加した予定表の表示名は「追加予定表2」ですので、以下のFoldersオブジェクトの引数に”追加予定表2″と入力します。
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar).Folders(“追加予定表2“)
I列に「EntryID」が入っている場合は削除をするようにお願いします。
では実行してみましょう。
はい、2つ目の追加予定表へ予定が登録できましたね。
今回のVBAについて説明
これまですべての期間を対象にチェックをして登録をしていたので、処理時間がかかってしまいがちでしたが、
対象期間を設け、期間を絞ることによりチェック対象の件数が少なくなるので処理時間を短くすることができました。
サンプルでは抽出期間を12か月にしています。
intKikan = 12
抽出するスケジュールの開始日を指定します。
strStart = Format(DateAdd(“m”, -intKikan, Date), “yyyy/mm/dd”)
抽出するスケジュールの終了日を指定します。
strEnd = Format(DateAdd(“m”, intKikan, Date), “yyyy/mm/dd”) ‘
取得したOutlookオブジェクトを取得します。
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace(“MAPI”)
予定表のリストはolFolderCalendarというメンバーに格納されていますのでそれを指定しています。
追加した予定表はそのフォルダごとに分かれて格納されていますので、
追加した予定表の表示名をFoldersオブジェクトの引数に渡すことにより
追加した予定表のオブジェクトを取得することができます。
Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar).Folders(“追加予定表2”)
ExcelI列のEntryIDと登録されているEntryIDが一致していたら該当予定表を更新します。
If olItemBefor.EntryID = Cells(i, 9) Then
登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新します。
※更新の条件はご都合に応じて変更してください。この条件が無い場合はExcelの予定表すべて更新されますので、ご注意ください。
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)
ここで保存されます。
.Save
ExcelI列のEntryIDと登録されているEntryIDが一致していなかったら新規登録します。
If checkFlg <> 1 Then
今回追加した処理になります。
Moveメソッドで追加した予定表へアイテムを移動しolItemMoveへセットします。
Set olItemMove = olItem.Move(olFolder)
追加した予定表へ保存されるようなので、Saveは省略しました。
気になるようでしたら、Saveメソッドを入れておいてもよいかもしれません。
新規の場合は発行されたEntryIDをExcelシートのI列へ書き込みます。
Cells(i, 9) = olItem.EntryID
さいごに
いかがでしょうか。
今回は、
Excelにまとめたスケジュール一覧をOutlookの追加した予定表へ一括登録する方法について
まとめました。
他にもOutlook関連の操作をまとめていますので、よろしければご覧ください。
Excelの予定一覧から他人のOutlook予定表を登録、編集する方法
他人のOutlook予定表をExcelワークシートへ取り込む方法
【Excel VBA】先月、今月、翌月分のOutlook予定表データをワンクリックで取り込む
この記事の関連キーワード
ご説明ありがとうございます。
説明の通り、規定の予定表の下に作成した予定表に入れようとしましたが、やはり規定の予定表に予定が入ってしまいます。何か考えられる原因はあるでしょうか。
また別ですが、規定の予定表の下ではないところにある予定表に予定を入れるのは難しいでしょうか。
ご連絡ありがとうございます。
追加した予定表を指定したものの、規定の予定表にはいってしまう事象につきまして、
エラー無くアイテム登録はできていますので、設定面では問題ないかと思われます。
ただ、指定フォルダにアイテムが登録されていないということで、
Foldersオブジェクトの指定がされていないか、フォルダへの振り分けがうまく機能していないことが要因として考えられます。
お手数ですが、実装しているコードをご教示いただけますでしょうか。
日頃お世話になっております。
追加予定表への予定登録をVBAで自動化したく、探していたところ、こちらのぺージを見つけました。
やりたいことがそのままだったので、まずはコピペして利用しようとしたのですが、
Set olConItems = olFolder.Items
の部分にエラーが出てしまいます。
内容は『メソッドまたはデータメンバーがみつかりません』との事です。設定の確認などもしたのですが、見当たらず。F1から開けるヘルプを見ても、分からない状態です。
原因と、解決策が有れば、ご教授いただければ幸いです。
よろしくお願いいたします。
いつもご利用ありがとうございます。
エラー内容から参照設定、追加予定表の設定は問題ないようですが、
olFolder.Itemsがうまく機能していないようです。
考えられる要因としましては、
①既定のアカウントの追加予定表を指定していない（共有の予定を指定している）
②スクリプトによる予定表へのアクセスが禁止されている
でしょうか。
まずは①あたりをご確認頂きたくお願いいたします。
よろしくお願いいたします。