Outlookの予定表で会議出席依頼を送信する機会は多いかと思います。
そんな中で困ることことは、
・複数の会議出席依頼を出す場合は、件数分新規作成しなければならないので面倒
ではないでしょうか？
実はOutlookとExcelのVBAを組み合わせて利用すると
Excelでまとめた会議情報から会議出席依頼を生成、送信することができるのです。
今回はそんな実用性が高い、
についてまとめます！
もくじ
Excelにまとめた会議情報からOutlookの会議出席依頼を送信する方について
今回のマクロ実行環境はスケジュール一覧があるExcel側となります。
Excelの会議情報一覧から一件づつ取り出しOutlookの予定表へ会議を登録・送信する流れとなります。
②Excelブック ← 会議を登録・送信したよ ← Outlook
次に早速実装をして動かしてみましょう！
Excel VBAからOutlookを操作するための下準備
①まずExcelを起動し、「開発」タブをクリックします。
②VBEの画面が開いたら、メニューから「ツール」>「参照設定」を選択します。
③「Microsoft Outlook XX.X Object Library」を探してチェックボックスにチェックし「OK」をクリックします。
以上です。
VBAを実装する
続いてVBAを実装します。
今回VBAは以下の通りとなります。
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 olItemBefor As AppointmentItem
'重複チェックフラグ初期値設定
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
Dim i 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)
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)
.Recipients.ResolveAll
.MeetingStatus = 1 '予定を "会議" に設定 ※「olMeeting」でもOK
.Send '送信
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) = "" And Cells(i, 3).Text <> "" 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)
.Recipients.ResolveAll
.MeetingStatus = 1
.Send '送信
End With
'ExcelI列へ発行されたEntryIDを書き込みをします。
Cells(i, 9) = olItem.EntryID
'ExcelF列へ予約者を書き込みをします。
Cells(i, 6) = olItem.Organizer
End If
'重複フラグリセット
checkFlg = 0
Next
Else
MsgBox "処理を中断します"
End If
'オブジェクトを解放します。
Set olItem = Nothing
Set olApp = Nothing
Set wbBook = Nothing
Set wsSheet = Nothing
Set olNamespace = Nothing
Set olFolder = Nothing
Set olConItems = Nothing
'スクリーンの更新をオンにします。
Application.ScreenUpdating = True
MsgBox "会議出席依頼の送信が完了しました！", vbInformation
End Sub実装手順は以下の通りです。今回はExcel側にこのVBAを実装します。
①Excelを新規に開き、「開発」タブをクリックし、「VisualBasic」をクリックします。
もしくはショートカットキー「Alt」＋「F11」でもOKです。
②標準モジュールを追加します。
左ペインのVBAProjectを右クリックし、「挿入」、「標準モジュール」を選択します。
③右ペインのウインドウに上記のマクロを入力します。
こちらで完了です。
会議出席依頼のデータを準備する
会議出席依頼のデータを準備しましょう。
VBAを実装したExcelのシートへ
以下の項目に沿って記入をしていきます。
| 件名 | 場所 | 開始日時 | 終了日時 | 予定の本文 | 予約者 | 必須出席者 | 任意出席者 | EntryID |
| 件名を入力 | 場所を入力 | 開始日時を”yyyy/mm/dd hh:mm:ss”形式で入力 | 終了日時を”yyyy/mm/dd hh:mm:ss”形式で入力 | 予定の本文を入力 | 予約者が登録後入ります。空でOKです。 | 必須出席者のアドレスを入力 | 任意出席者のアドレスを入力 | 会議識別子のEntryIDが登録後入ります。空でOKです。 |
サンプルでは以下のように入力しています。
VBAを実行し、会議出席依頼を送信する
メール誤送信予防の設定をする
今回はメールを送信しますが、メール誤送信防止のためにメールが即送信とならない設定をしておきましょう。
①Outlookのオプションを開きます。
②左ペイン詳細設定をクリックします。
③右ペイン送受信＞「接続したら直ちに送信する」のチェックを外し、OKをクリックします。
続いて、VBAを実行してみましょう。
VBAを実行する
①「開発」タブの「マクロ」をクリックします。
②「Outlookから会議出席依頼を送信する」を選択し、「実行」をクリックします。
③メッセージ「会議出席依頼の送信が完了しました！」が表示されば完成です！
予定用へ会議スケジュールが登録されましたね。
登録した2件の会議内容を確認しましょう。
宛先、件名、本文共にExcel通りに入っていますね！
次に会議出席依頼が送信されているかチェックしてみます。
Outlookの送信トレイを見てみましょう。
はい、会議出席依頼メールが送信されていることが確認できましたね！
会議のスケジュール、内容を変更し再送信する
会議のスケジュール、内容を変更し再送信してみましょう。
①Excelの件名、開始日時、終了日時を変更します。
②「Outlookから会議出席依頼を送信する」を選択し、「実行」をクリックします。
③メッセージ「会議出席依頼の送信が完了しました！」が表示されば完成です。
予定用へ変更後の会議スケジュールになりましたね。
会議変更通知も送信されていますね。
今回のVBAについて説明
対象期間を設け、期間を絞ることによりチェック対象の件数が少なくなるので処理時間を短くすることができました。
サンプルでは抽出期間を12か月にしています。
抽出するスケジュールの開始日を指定します。
抽出するスケジュールの終了日を指定します。
取得したOutlookオブジェクトを取得します。
Set olNamespace = olApp.GetNamespace(“MAPI”)
予定表のリストはolFolderCalendarというメンバーに格納されていますのでそれを指定しています。
ExcelI列のEntryIDと登録されているEntryIDが一致していたら該当予定表を更新します。
登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新します。
※更新の条件はご都合に応じて変更してください。この条件が無い場合はExcelの予定表すべて更新されますので、ご注意ください。
定期的な予定でない場合変更します。
Excel側の値を読み込み、予定オブジェクトにセットします。
.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)
.Recipients.ResolveAll
予定を “会議” に設定します。「olMeeting」でもOKです。
OlMeetingStatusプロパティの値の詳細は以下の通りです。
| Name | Value | Description |
|---|---|---|
| olMeeting | 1 | 予定が組まれた状態。 |
| olMeetingCanceled | 5 | 予定が取り消された状態。 |
| olMeetingReceived | 3 | 参加要請が受信された状態。 |
| olMeetingReceivedAndCanceled | 7 | 予定されていた会議が取り消されたが、ユーザーの予定表にはまだ表示されている状態。 |
| olNonMeeting | 0 | 参加者なしで予定が組まれた状態。?予定表に休日を設定する際、この状態が生じることがあります。 |
※参考：https://docs.microsoft.com/ja-jp/office/vba/api/outlook.olmeetingstatus
Sendメソッドでメール送信します。
ExcelI列のEntryIDと登録されているEntryIDが一致していなかったら新規登録します。
新規の場合は発行されたEntryIDをExcelシートのI列へ書き込みます。
＜追加＞日本語交じりのURLを日本語も含む形でハイパーリンクを付与するよう機能（URLエンコード処理）追加
日本語交じりのURLを入力すると、会議/予定アイテム生成時にハイパーリンクが日本語の手前で切れてしまう問題があります。
Excelの本文欄へ日本語交じりのURLを入力します。
VBA実行後、会議アイテムの本文欄にハイパーリンクが入っていますが、日本語の手前までしか認識されていません。
Outlookの仕様で、2バイト文字をURLと認識しないことが原因ですね。
対策としては手直しすることが簡単で速いのですが、
予定や会議を生成するたびにハイパーリンクを手直しすることは少々面倒です。
そこで、Excelで入力した本文の内容にhttps始まりのURLがあればURLエンコードをするよう処理を追加し、
日本語交じりでもハイパーリンクが付くようにしてみました。
サンプルコードは以下の通りです。
Sub Outlookから会議出席依頼を送信する__URLエンコード追加()
'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
'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
'URLエンコードの条件を定義します。
'「http」を指定。「http」や「https」に該当。
Const myHyperlink = "http"
Dim objApp As New Excel.Application
Dim arrUrlLists As Variant
Dim strURL As Variant
'対象予定表の抽出期間を月単位で指定します。
'※抽出期間が短いと予定アイテムのチェックができず登録できない場合がありますので注意してください｡
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)
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)
'本文のURLエンコード処理---ここから
arrUrlLists = Split(Cells(i, 5), vbLf)
For Each strURL In arrUrlLists
If InStr(strURL, myHyperlink) Then
'一文字づつ取り出し、半角記号以外をエンコードする
For k = 1 To Len(strURL)
strMoji = Mid(strURL, k, 1)
If strMoji Like "[ -/:-@\[-~]" Then
'If strMoji Like "[ぁ-んァ-ヴー亜-熙一-龠々]" Then
strMojiTemp = strMojiTemp & strMoji
Else
strMojiTemp = strMojiTemp & objApp.WorksheetFunction.EncodeURL(strMoji)
End If
Next
'エンコード後の文字列を結合する
strBody = strBody & vbCr & strMojiTemp
Else
strBody = strBody & vbCr & strURL
End If
Next
'本文のURLエンコード処理----ここまで
'重複チェック＆更新処理
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")
.BodyFormat = "olFormatHTML"
.Body = strBody
.RequiredAttendees = Cells(i, 7)
.OptionalAttendees = Cells(i, 8)
.Recipients.ResolveAll
.MeetingStatus = 1 '予定を "会議" に設定 ※「olMeeting」でもOK
.Send '送信
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) = "" And Cells(i, 3).Text <> "" 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 = strBody
.RequiredAttendees = Cells(i, 7)
.OptionalAttendees = Cells(i, 8)
.Recipients.ResolveAll
.MeetingStatus = 1
.Send
End With
'ExcelI列へ発行されたEntryIDを書き込みをします。
Cells(i, 9) = olItem.EntryID
'ExcelF列へ予約者を書き込みをします。
Cells(i, 6) = olItem.Organizer
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 "会議出席依頼の送信が完了しました！", vbInformation
End Sub日本語混合のURLを入力し、VBAを実行してみます。
はい、日本語の部分がエンコードされ、ハイパーリンクが文字列の最後までつきましたね！
リンクをクリックしてみましょう。
はい、「日本語」と表示されていますね！
＜追加＞Excelから登録済み会議のキャンセル通知をする
Excelから会議のキャンセル通知を出す方法について説明をします。
ExcelのK列にキャンセルの項目を作成します。
ここにフラグ「True」を入れると該当する会議のキャンセル通知がされる仕様とします。
VBAを実装する
サンプルコードは以下の通りです。
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
'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)
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
'キャンセル通知処理追加
If Cells(i, 11) Then
With olItemBefor
.MeetingStatus = 5 '予定を "キャンセル" に設定します。 ※「olMeetingCanceled」でもOK
.Display '会議を表示させます。
.Send '会議を送信します。
'.Delete '会議アイテムを削除します。有効化する場合はコメントアウトを外してください。
'Cells(i, 9) = "" 'Excelに書き込まれたEntryIDを削除します。.Deleteを有効化した場合はこちらも有効化してください。
End With
End If
Else
'定期アイテムは除外します。
If Not olItemBefor.IsRecurring 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)
.Recipients.ResolveAll
.MeetingStatus = 1 '予定を "会議" に設定 ※「olMeeting」でもOK
.Send '送信
End With
End If
End If
End If
End If
Next
'EntryIDが空かつ、開始日時が空でない場合のみ新規登録します。
If checkFlg <> 1 And Cells(i, 9) = "" And Cells(i, 3).Text <> "" 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)
.Recipients.ResolveAll
.MeetingStatus = 1
.Send
End With
'ExcelI列へ発行されたEntryIDを書き込みをします。
Cells(i, 9) = olItem.EntryID
'ExcelF列へ予約者を書き込みをします。
Cells(i, 6) = olItem.Organizer
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 "会議出席依頼の送信が完了しました！", vbInformation
End Sub会議を新規登録する
続いてキャンセルは既存の会議予約が対象となりますので、
Excel側の会議情報を入力し終えたらVBAを実行し会議を登録/送信します。
Excelへキャンセルフラグを入力する
次にキャンセルしたい会議情報がある行のK列へ「TRUE」と入力します。
VBAを実行する
VBAを実行してみましょう。
はい、会議がキャンセルされましたね！
通知が送信されていますね。
該当会議がキャンセル扱いになりました。
また、キャンセル後に会議アイテム自体を削除したい場合は、
'.Delete '会議アイテムを削除します。のコメントアウトを外し有効化します。
実行してみましょう。
はい、会議アイテムが削除されていますね。
VBAの説明
キャンセル通知の機能について説明をします。
Excelのキャンセル通知項目に値があるか確認し、あればキャンセル通知処理をおこないます。
If Cells(i, 11) Then予定を “キャンセル” に設定します。 ※「olMeetingCanceled」でもOKです。
.MeetingStatus = 5 会議を表示させます。
.Display会議を送信します。
.Send会議アイテムを削除します。
.Delete Excelに書き込まれたEntryIDを削除します。.Deleteを有効化した場合はこちらも有効化してください。
'Cells(i, 9) = ""＜追加＞会議へアラームを設定する
会議へアラームを設定する方法について説明をします。
設定するプロパティは以下の通りです。
| プロパティ | 説明 |
|---|---|
| ReminderSet | アラーム有無をTrue/Falseで指定 |
| ReminderMinutesBeforeStart | 何分前にアラームを鳴らすタイミングを指定※単位は分になります。 |
ExcelのL列に「アラーム有無」、M列に「アラーム発生時間（予定時間何分前）」を追加し値を入力します。
olItem、olItemBeforオブジェクトのプロパティ指定へ以下を追記します。
'アラーム追加
.ReminderSet = Cells(i, 12) 'アラーム有無を指定します。
.ReminderMinutesBeforeStart = Cells(i, 13) 'アラームを鳴らすタイミングをしてします。VBAを実行すると、
はい、アラームが設定されましたね！
＜追加＞他人の空き時間をチェックし空きがない場合は宛先から除外する
他人の空き時間をチェックし空きがない場合は宛先から除外する方法について説明をします。
機能の内容は、必須出席者に指定したアドレスを対象に、設定したい会議時間帯の空き時間を調べ、予定が無いか、予定があっても「予定あり」（定数2）以外（仮の予定など）になっていれば必須出席者のアドレスとして加え、予定がある場合は必須出席者に含めない内容とします。
Functionプロシージャ
他人の空き時間をチェックする機能をFunctionプロシージャで実装します。
サンプルコードは以下の通りです。
Function 他人の空き時間チェックとない場合除外する(strAddresses As String, strStart As String, strEnd As String)
'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 strAddress As Variant
Dim recOther As Recipient
Dim objAppt As AppointmentItem
Dim strFlag As String
Dim arrAddress As Variant
Dim strTempAddresses As String
'文字列を時間の形式に変換します。
strStart = Format(strStart, "yyyy/mm/dd hh:mm")
strEnd = Format(strEnd, "yyyy/mm/dd hh:mm")
'会議通知先アドレスを；区切りで分割し配列へ格納します。
arrAddress = Split(strAddresses, ";")
'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
'アドレスの件数分処理を繰り返します。
For Each strAddress In arrAddress
Debug.Print strAddress
'他人のオブジェクトを指定し取得します。
Set recOther = olNamespace.CreateRecipient(strAddress)
'取得した他人のオブジェクトの内、予定表のみ絞り込み再取得します。
Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderCalendar)
Set olConItems = olFolder.Items
'開始日でソートします。
olConItems.Sort "[Start]"
'Trueで定期的な予定を含むようにします。※Falseであると定期的な予定は含まれません。
olConItems.IncludeRecurrences = True
'Findメソッドで期間指定して抽出する予定を絞り込む
Set olItem = olConItems.Find("[Start] >= """ & strStart & """ AND [End] <= """ & strEnd & """")
While TypeName(olItem) = "AppointmentItem"
Debug.Print olItem.BusyStatus
Debug.Print olItem.Subject
Debug.Print olItem.Start
Debug.Print olItem.End
'Findで検索すると期間範囲外の余計なものまでヒットしてしまうので、再度フィルタリングします。
If (olItem.Start >= strStart And olItem.End <= strEnd) Then
'対象期間の予定のビジー状態予定ありの場合、チェックフラグにNGを設定します。
If olItem.BusyStatus = 2 Then
strFlag = "NG"
End If
End If
'次の検索を行います。
Set olItem = olConItems.FindNext
Wend
'チェックフラグが"NG"でない場合のみアドレス対象リストに加えます。
If strFlag <> "NG" Then
strTempAddresses = strTempAddresses & ";" & strAddress
End If
Debug.Print strFlag
'チェックフラグを初期化します｡
strFlag = ""
Next
'結果を返します。
他人の空き時間チェックとない場合除外する = strTempAddresses
'オブジェクトを解放します。
Set olItem = Nothing
Set olConItems = Nothing
Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing
Set recOther = Nothing
End Functionもし会議開始時間や終了時間を跨ぐ会議や予定も確認対象としたい場合は範囲を追加してください。
Find("[Start] >= """ & strStart & """ AND [End] <= """ & strEnd & """")会議出席依頼を送信するコードを変更する
続いて、会議出席依頼を送信するコードの以下の箇所を変更します。
■変更前
.RequiredAttendees = Cells(i, 7)■変更後
.RequiredAttendees = 他人の空き時間チェックとない場合除外する(Cells(i, 7), Cells(i, 3), Cells(i, 4))「他人の空き時間チェックとない場合除外する」Functionプロシージャの書式は以下となります。
.RequiredAttendees = 他人の空き時間チェックとない場合除外する(＜；区切りのアドレスリスト＞, ＜開始日時 "yyyy/mm/dd hh:mm"＞, ＜終了日時 "yyyy/mm/dd hh:mm"＞)必須出席者設定のところで上記Functionプロシージャを呼び出しアドレスに対する空き時間をチェックし空き時間があるアドレスのみ絞り込んだリストを代入する内容となります。
動作確認をする
必須出席者の一人を、会議設定時間帯に予定を入れ、そのアドレスが除外されるか確認をしてみましょう。
サンプルでは主催者は会議を入れる時間帯に予定はなし、必須出席者のuserAは別の会議を入れています。
Excel側の会議設定情報に別会議が存在するuserAを含めます。
VBAを実行してみましょう。
はい、必須出席者から予定があるuserAが除外され会議設定されていますね。
＜追加＞会議出席依頼にTeams会議をVBAで設定する
読者様より会議出席依頼時に併せてTeams会議をVBAで設定する方法はないか質問がありましたので、その方法を追記いたします。
操作の内容としては、会議出席依頼のメニューにある「Teams会議」ボタンを押したときに本文へTeams会議のリンクが挿入されるといった内容となります。
ただ今のところVBAでは、Teamsを扱うライブラリはありませんので、ライブラリを使わない方法で実現をする必要があります。
そこで、今回採用した方法は、「Teams会議」ボタンを押下するショートカットキーをVBAで再現するといった形で機能を実現していきます。
「Alt」キーを押すと、リボンのタブが選択された状態になり、「HTM」キーを押すと「Teams会議」ボタンにたどり着いて押した状態になるので、この内容をVBAへセットします。
VBAを実装する
サンプルコードは以下の通りです。
新規会議出席依頼のSendメソッドの前にコードを追加します。
■変更前
.Send '送信■変更後
'---Teams会議挿入処理追加
.Display '会議通知を表示します。
Application.Wait (Now + TimeValue("00:00:02")) '表示されるまで待ちます。
SendKeys "%", True 'Altキーを押してタブを選択します。
Application.Wait (Now + TimeValue("00:00:01")) '表示されるまで待ちます。
SendKeys "HTM" 'Teams会議ボタンのショートカットキーを押します。
Application.Wait (Now + TimeValue("00:00:02")) '表示されるまで待ちます。
'---ここまで
.Send '送信
VBAを実行する
VBAを実行してみましょう。
はい、Teams会議が設定されていますね！
VBAの説明
Teams会議を設定する機能について説明をします。
会議通知を一度表示させます。これはショートカットキーによるボタン操作を有効化するためになります。
.Display 表示されるまで数秒処理を保留にします。これがない場合は表示される前にショートカットキーが押下されることがありますので、必ず入れるようにしてください。
Application.Wait (Now + TimeValue("00:00:02"))
Altキーを押してタブを選択します。”%”はAltの意味となります。
SendKeys "%", True Teams会議ボタンのショートカットキー（”HTM”）を押します。
SendKeys "HTM" ＜追加＞会議出席依頼に分類項目で設定する
読者様より会議出席依頼時に併せてカテゴリ分類項目をVBAで設定する方法はないか質問がありましたので、その方法を追記いたします。
内容としては、色分けされている分類項目の名前をExcel側のM列に指定し、
会議出席依頼生成時に該当する分類項目を設定する処理となります。
VBAを実装する
サンプルコードは以下の通りです。
会議出席依頼のOptionalAttendeesプロパティの後にコードを追加します。
■変更前
.OptionalAttendees = Cells(i, 8)■変更後
.OptionalAttendees = Cells(i, 8)
.Categories = Cells(i, 13)
VBAを実行する
まずはオレンジの分類を指定して、新規送信をしています。
VBAを実行してみましょう。
はい、オレンジの分類が設定され、オレンジ色になりましたね！
続いて、青の分類に設定してみましょう。
会議通知変更の場合は件名や日付を変えないと送信されませんので、今回は件名を変更します。
VBAを実行してみましょう。
はい、青の分類が設定され、青色になりましたね！
VBAの説明
分類項目を設定する機能について説明をします。
今回使用したプロパティはCategoriesといい、分類項目を設定することができます。
| 名前 | 説明 |
|---|---|
| Categories | Outlook アイテムに割り当てられた分類項目を表す文字列を設定または返します。 値の取得と設定が可能です。 |
このプロパティに13列目のM列のセルの値を指定することにより、分類項目を設定することができます。
.Categories = Cells(i, 13)
さいごに
いかがでしょうか。
今回は
についてまとめました。
Outlookの操作は手作業が多いですからなるべく自動化して効率化を図りたいですね。
この記事の関連キーワード
「予定表」の関連記事
こちらの記事の内容「予定表」に関連する記事一覧です。
【VBA】Excel からOutlookの会議出席依頼を送信する方法！会議変更後の送信も対応！
【VBA】Outlook会議通知の重要度を設定する方法！
【Excel VBA】Outlookの他人の予定表をExcelシートへ取り込む方法
【VBA】一瞬で複数ユーザのOutlook予定表をExcelへ取り込む方法！
【VBA】Excelの表をOutlookの予定表へ挿入する方法！画像貼り付けも可！
【Excel VBA】一瞬でExcelワークシートへOutlookの予定表を取り込む方法
【VBA】他人のOutlook予定表へExcelから登録、編集、代理送信する方法
【VBA】Excel からOutlookへ終日の予定を登録する方法！複数日指定も！
いつもありがとうございます！
一点質問なのですが、指定の宛先からスケジュールを飛ばすコードがあればお教えいただきたく存じます。。。
いつもご利用ありがとうございます。
指定の宛先からスケジュールを送信する方法については
以下をご参考いただきたくお願いいたします。
https://extan.jp/?p=2275
＞代理人として会議出席依頼を送信する場合の設定
ご回答ありがとうごさいます。
共有アカウントの管理は会社なので、あまり設定はいじれなさそうですが、原因がなんなのか分かれたので助かりました。
とりあえず、気長に送信を待とうと思います。
期間はだいぶ絞っており、すべての送信指示(.sendメソッド)はできてそうです。
ちなみにですがまだ送信できていない送信指示内容はどこかで確認することができるのでしょうか？
すべて処理できているようでよかったです。
送信前の送信指示内容の確認方法につきましては、Outlookの「送信トレイ」のアイテムの有無で確認できます。
こんにちは
Outlookの一括登録/編集/削除の記事、とても参考になりました。ありがとうございます。
処理自体は完成したのですが、招待メールの送信が遅く、outlook予定表への反映がとても遅いです。
具体的にご説明しますと、15人くらいのメンバーに勤怠予定(休みや有給)などを会議に見立てて、共有アカウントから招待送信しています。送信後は共有アカウントの予定からは会議を削除し招待者には削除したことを送信しないようにしています。
高速処理にしたい、また別excelファイルを開いた時にメッセージを表示させないため、以下を最初と最後に入れてます。
•Application.ScreenUpdating
•Application.DisplayAlerts
•Application.AskToUpdateLinks
削除処理を入れない別のsubでも同じようにメールの送信が遅いです。こころなしかアプリ版outlookを手動で開くと、送信されるような気がします。
単純に処理数が多いため、メール送信が遅いのでしょうか？それともvba コードに何かしら遅くしてしまう処理を入れてしまっているのでしょうか？
お手数ですがご回答おねがいします。
いつもご利用ありがとうございます。
Outlookのメール送信が遅い件につきまして、VBAのSendメソッドはOutlookアプリケーションに送信指示を出すまでの処理ですので、
送信（送信済みとなる）が遅い要因としては送信前に承認プロセスなどセキュリティチェックを入れていたり、即時送信をさせない（送信までタイムラグを設けている）などExchange側の仕様による可能性がありますので、この点についてご確認いただけますでしょうか。
削除/編集処理につきましては登録されているアイテム数が多いほど処理時間がかかる形となります。
対応としましては、期間を短くしたり、不要なアイテムは削除するなどしてチェック対象のアイテム数を少なくするようにお願いします。