①Excelブック(VBA) → 予定表へ会議を登録・送信して → 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
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
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
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
【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へ終日の予定を登録する方法！複数日指定も！
ありがとうございました。
確認してみます。
先日の質問に対する回答ありがとうございます。
素人質問で申し訳ありません。
「実行時エラー440」が発生する理由として、 Outlookのアイテムの同期に問題がある場合に発生することが多いです。
まず、エラーが発生するフォルダーがオンラインモードでアクセス可能か確認してください。
とのことでしたが、「エラーが発生するフォルダーがオンラインモードでアクセス可能」の確認はどの画面上で行えばよろしいでしょうか？
なお、Outlookの再起動ではエラー解消が残念ながらできませんでした。
ご教授お願いします。
「エラーが発生するフォルダーがオンラインモードでアクセス可能か確認する」ためには、以下の手順を試してみてください。
Outlookを開き「送受信」タブをクリックします。
リボンメニューにある「オフライン作業」ボタンが押されていないことを確認します。
押されていれば、ボタンをクリックしてオフラインモードを解除し、オンラインモードに戻します。
続いて、「アカウント設定」から使用しているメールアカウントを選択し、キャッシュモードを使用のチェックボックスがオンになっていることを確認します。
そして、確認したいフォルダーを右クリック「プロパティ」を選択し「同期」タブから、同期が正常に行われているか確認し、フォルダーへアクセスしてみてください。
はじめまして、いつも参考にさせていただいております。
実行時エラーが発生するため、どのように対応すべきか確認させてください。
2週間ほど前にVBAを作成し実行できていたのですが、
改めて実行すると、実行時エラーが発生します。
原因が不明のため、対処方法があればご教授ください。
「実行時エラー440
同期を取ったフォルダーのアイテムが一致しません。重複を解消するためには、アイテムを開き、そしてもう一度この操作を行ってみてください。」
デバックを確認すると、
「If olItemBefor.EntryID = Cells(i, 9) Then」の部分です。
列に問題なさそうですが、確認すべき箇所がほかにもあるのでしょうか？
いつもご利用ありがとうございます。
「実行時エラー440」が発生する理由として、Outlookのアイテムの同期に問題がある場合に発生することが多いです。
まず、エラーが発生するフォルダーがオンラインモードでアクセス可能か確認してください。
また、PC側のOutlookを再起動すると同期処理が行われ同期状態になりますので、こちらも試してみてください。
こんにちは
Outlookの一括登録/編集/削除の記事、参考にさせていただいております。
非常に有益で感謝しております。
＜追加＞Excelから登録済み会議のキャンセル通知をする について質問させてください。
‘キャンセル通知処理追加
If Cells(i, 11) Then
With olItemBefor
.MeetingStatus = 5 ‘予定を “キャンセル” に設定します。 ※「olMeetingCanceled」でもOK
.Display ‘会議を表示させます。
.Send ‘会議を送信します。
‘.Delete ‘会議アイテムを削除します。有効化する場合はコメントアウトを外してください。
‘Cells(i, 9) = “” ‘Excelに書き込まれたEntryIDを削除します。.Deleteを有効化した場合はこちらも有効化してください。
End With
End If
の部分ですが、複数のキャンセル処理を行うと、1件目は ”.Display ‘会議を表示させます。”が正常に処理されるのですが、２件目以降は、” .Display ‘会議を表示させます。”が行われずに、会議の開催者はキャンセルされるのですが、出席依頼を行った宛先には、会議案内が残ってしまう事象が発生してしまっております。
これを解決させるためには、どういったコーディングを行うかをご指南いただきたく存じます。
お手数ですがご回答おねがいします。
いつもご利用ありがとうございます。
２件目以会議の開催者はキャンセルされるが、出席依頼を行った宛先には、会議案内が残ってしまう事象につきまして、
開催者側はキャンセルされていることから、キャンセル処理は問題なくできていると思われます。
問題は、表示と送信処理となりますが、申し訳ありませんが事象の再現が難しく原因が特定できかねる状況です。
お手数ですが、Sendメソッドを無効化し、手動にてキャンセル状態を確認の上送信いただけますでしょうか。
よろしくお願いいたします。
とても役にたつVBAの情報を公開いただきありがとうございます。
＜追加＞Excelから登録済み会議のキャンセル通知をするVBAの説明
について1点質問させてください。
キャンセル通知の機能を省略し、マクロ実行時に通知なくキャンセルを実行する処理を行う場合には、下記のようにVBAを設定すればよろしいでしょうか？
通知を行わずに、キャンセルを実行させるコードはどのように書けばよいかをご指南承りたく存じます。
If Cells(i, 11) Then
予定を “キャンセル” に設定します。 ※「olMeetingCanceled」でもOKです。
.Send
会議アイテムを削除します。
.Delete
Excelに書き込まれたEntryIDを削除します。.Deleteを有効化した場合はこちらも有効化してください。
‘Cells(i, 9) = “”
いつもご利用ありがとうございます。
キャンセル通知の機能を省略し、マクロ実行時に通知なくキャンセルを実行する処理につきましては、
公開コードの
.Send
を
.Save
に変更いただければ可能かと存じます。
よろしくお願いいたします。
自分のスケジュールには登録されましたが、メールは送信されていません。の件自己解決いたしました。失礼いたしました。
自己解決されたようでよかったです。
【VBA】一瞬でExcelのスケジュールをOutlookの予定表へ登録/変更する方法をいつも便利に利用させて頂いています。【VBA】Excel からOutlookの会議出席依頼を送信する方法！会議変更後の送信も対応！試してみましたが、メッセージ「会議出席依頼の送信が完了しました！」が表示され、自分のスケジュールには登録されましたが、メールは送信されていません。自分のイベントの会議には各メンバーがスケジュールが登録されています。
VBAを使用せずにOutlookイベント会議を設定は、各メンバーと可能な環境です。何処に不備があるのでしょうか？
はじめまして。
こちらのVBAによって、業務効率化にとても役立っています。
ありがとうございます。
Excelに50件ほど登録しました。
会議依頼メールを1日おきに上から10件ずつ送信し、5日かけて50件送信完了させたいです。
すでに1日目の10件は送信済みです。
一番右側のセルの右下にあるカーソルを合わせて、2日目の10件を送信する場合、
1日目の送信済みの10件も再送信されてしまいますでしょうか。
いつもご利用ありがとうございます。
ご質問の登録50件の会議通知アイテムを1日10件に分けて送信した場合、送信済みアイテムが再送されてしまうかにつきまして、
EntryIDがなければ新規登録・送信がされ、EntryIDがあり、送信後から件名、開始日時、終了日時の変更があれば再送される仕様ですので
まずは、送信済みアイテムについて、ExcelのI列へ発行されたEntryIDがあるかご確認いただけますでしょうか。
またEntryIDがあったとしても変更があれば送信されますので、念のため宛先を限定的にしたテストデータなどで新規送信後に送信がされないか併せてご確認願います。
分かりやすい解説付きでとても勉強になり、助かっています。
「Outlookのメール送信が遅い件」について、
わたくしは、経験から
.send の後の
Set olApp = Nothing
の前に sleep で5秒ほど、時間を待たせています。
※送信トレイに送られてから、実際送信処理が終わる前に、olApp（Outlook.Application）を閉じていることが要因かと推定しました。
いつもご利用ありがとうございます。
アドバイスいただけましたこと大変ありがたく存じます。
送信件数が多い場合など送信処理完了前にオブジェクト開放をしてしまうリスクはあるかと存じますので、
こちらでも検証をするようにいたします。
初めまして。
貴重な記事をありがとうございます。
複数のファイルを会議出席依頼に添付する方法がございましたら、ご教示頂きたく。
よろしくお願い致します。
いつもご利用ありがとうございます。
複数のファイルを会議出席依頼に添付する方法につきまして、
記事にファイル単体、複数のパターンで追記をいたしましたので
よろしければご参考ください。
https://extan.jp/?p=3636#%EF%BC%9C%E8%BF%BD%E5%8A%A0%EF%BC%9E%E4%BC%9A%E8%AD%B0%E5%87%BA%E5%B8%AD%E4%BE%9D%E9%A0%BC%E3%81%AB%E8%A4%87%E6%95%B0%E3%81%AE%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%82%92%E6%B7%BB%E4%BB%98%E3%81%99%E3%82%8B
はじめまして、いつも参考にさせていただいております。
ありがとうございます。
会議出席依頼にTeams会議をVBAで設定し、無事Teams会議設定はできたのですが、
日時変更すると、本文に記載されたTeamsのリンク(下記)が消えてしまいます。
（変更時の本文のみになってしまいます）
「—————————————————
Microsoft Teams meeting
コンピューターまたはモバイル アプリで参加できます
会議に参加するにはここをクリックしてください （以下）」
↑この部分が消えます。。
ただ、上部リボンには「Teams会議に参加」があるので、
リンクが解除されたわけではないようですが、Teamsを使い慣れていない人は、
リンクが無いと連絡してくるため、本文のTeamsメッセージ＆リンクの表示をしたままにしたいのですが、どのようにしたら消えないでしょうか？
ご教示のほど、よろしくお願いいたします。
いつもご利用ありがとうございます。
会議出席依頼の日時変更時に本文のTeams会議が消えてしまう件につきまして、
Excelに記載されている本文の内容を転記する処理が行われていることが原因となっております。
日時変更のみということであれば、変更処理の以下のコードを削除するか、コメントアウトして無効化すればTeams会議が消えてしまうことは回避できます。
.Body = Cells(i, 5)
ただしこの場合は本文の変更処理が効かなくなりますことご了承ください。
もう一つの方法としては、会議出席依頼新規作成時にTeams会議設定後、Teams会議情報を含む本文の内容をExcel側に書き込み、変更時にそのデータを使うといった内容です。
変更箇所は新規作成後のところになります。
■変更前
‘ExcelF列へ予約者を書き込みをします。
Cells(i, 6) = olItem.Organizer
■変更後
‘ExcelF列へ予約者を書き込みをします。
Cells(i, 6) = olItem.Organizer
‘ExcelE列へ本文を書き込みをします。
Cells(i, 5) = olItem.Body
なお、この場合も欠点があり、Bodyプロパティから取得する情報はテキスト形式となるため、ハイパーリンク部分はhttps始まりのパス情報に置き換わりますことご了承ください。
ご検討のほど、お願いいたします。
いつもありがとうございます！
一点質問なのですが、指定の宛先からスケジュールを飛ばすコードがあればお教えいただきたく存じます。。。
いつもご利用ありがとうございます。
指定の宛先からスケジュールを送信する方法については
以下をご参考いただきたくお願いいたします。
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側の仕様による可能性がありますので、この点についてご確認いただけますでしょうか。
削除/編集処理につきましては登録されているアイテム数が多いほど処理時間がかかる形となります。
対応としましては、期間を短くしたり、不要なアイテムは削除するなどしてチェック対象のアイテム数を少なくするようにお願いします。