【VBA】Excel からOutlookの会議出席依頼を送信する方法!会議変更後の送信も対応!

Outlookの予定表で会議出席依頼を送信する機会は多いかと思います。

そんな中で困ることことは、

・会議出席依頼の宛先を手入力するのは面倒
・複数の会議出席依頼を出す場合は、件数分新規作成しなければならないので面倒

ではないでしょうか?

実はOutlookとExcelのVBAを組み合わせて利用すると
Excelでまとめた会議情報から会議出席依頼を生成、送信することができるのです。

今回はそんな実用性が高い、

Excelにまとめた会議情報からOutlookの会議出席依頼を送信する方法と、会議内容やスケジュールを変更して再送信する方法

についてまとめます!

Excelにまとめた会議情報からOutlookの会議出席依頼を送信する方について

今回のマクロ実行環境はスケジュール一覧があるExcel側となります。

タカヒロ
タカヒロ
ExcelからOutlookの操作を行いますので、Outlookを起動していなくても予定の登録が可能です。

Excelの会議情報一覧から一件づつ取り出しOutlookの予定表へ会議を登録・送信する流れとなります。

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

実装手順は以下の通りです。今回は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か月にしています。

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というメンバーに格納されていますのでそれを指定しています。

Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)

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, 7)
.OptionalAttendees = Cells(i, 8)
.Recipients.ResolveAll

予定を “会議” に設定します。「olMeeting」でもOKです。

.MeetingStatus = 1

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メソッドでメール送信します。

.Send

ExcelI列のEntryIDと登録されているEntryIDが一致していなかったら新規登録します。

If checkFlg <> 1 Then

新規の場合は発行されたEntryIDをExcelシートのI列へ書き込みます。

Cells(i, 9) = olItem.EntryID

<追加>日本語交じりのURLを日本語も含む形でハイパーリンクを付与するよう機能(URLエンコード処理)追加

日本語交じりのURLを入力すると、会議/予定アイテム生成時にハイパーリンクが日本語の手前で切れてしまう問題があります。

Excelの本文欄へ日本語交じりのURLを入力します。

VBA実行後、会議アイテムの本文欄にハイパーリンクが入っていますが、日本語の手前までしか認識されていません。

Outlookの仕様で、2バイト文字をURLと認識しないことが原因ですね。

対策としては手直しすることが簡単で速いのですが、
予定や会議を生成するたびにハイパーリンクを手直しすることは少々面倒です。

そこで、Excelで入力した本文の内容にhttps始まりのURLがあればURLエンコードをするよう処理を追加し、
日本語交じりでもハイパーリンクが付くようにしてみました。

タカヒロ
タカヒロ
なお、URLエンコード機能はExcel2013以降のバージョンが対象となりますことご了承ください。

サンプルコードは以下の通りです。

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を実行してみます。

はい、日本語の部分がエンコードされ、ハイパーリンクが文字列の最後までつきましたね!

リンクをクリックしてみましょう。

はい、「日本語」と表示されていますね!

タカヒロ
タカヒロ
httpを含む行全体がハイパーリンクとなりますので、ハイパーリンク部分の文字列と文章の文字列を改行でわけるようお願いします。

<追加>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 何分前にアラームを鳴らすタイミングを指定※単位は分になります。

タカヒロ
タカヒロ
アラームの有無と何分前にならすかの2種類の設定を行う必要があります。

ExcelのL列に「アラーム有無」、M列に「アラーム発生時間(予定時間何分前)」を追加し値を入力します。

タカヒロ
タカヒロ
サンプルのアラーム発生時間の値240は分単位ですので4時間を指定している形になります。

olItem、olItemBeforオブジェクトのプロパティ指定へ以下を追記します。

'アラーム追加
.ReminderSet = Cells(i, 12) 'アラーム有無を指定します。
.ReminderMinutesBeforeStart = Cells(i, 13) 'アラームを鳴らすタイミングをしてします。

VBAを実行すると、

はい、アラームが設定されましたね!

 

<追加>他人の空き時間をチェックし空きがない場合は宛先から除外する

他人の空き時間をチェックし空きがない場合は宛先から除外する方法について説明をします。

機能の内容は、必須出席者に指定したアドレスを対象に、設定したい会議時間帯の空き時間を調べ、予定が無いか、予定があっても「予定あり」(定数2)以外(仮の予定など)になっていれば必須出席者のアドレスとして加え、予定がある場合は必須出席者に含めない内容とします。

タカヒロ
タカヒロ
今回のFunctionプロシージャ使用にあたり、空き時間参照先アドレスの参照権限が必要になりますので、権限の設定をするようお願いいたします。

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 '送信

タカヒロ
タカヒロ
会議出席の変更処理の方に追加すると、既存のTeams会議がある場合エラーとなりますので、新規作成側のみに追加するようお願いします。

VBAを実行する

VBAを実行してみましょう。
はい、Teams会議が設定されていますね!

タカヒロ
タカヒロ
「Teams会議」ボタンを押した際「場所」は自動挿入されますが、Excel側の「場所」に値がある場合はこちらが優先され自動挿入されませんので、Excel側の「場所」のセルは空欄にしておきましょう。

VBAの説明

Teams会議を設定する機能について説明をします。

会議通知を一度表示させます。これはショートカットキーによるボタン操作を有効化するためになります。

.Display

表示されるまで数秒処理を保留にします。これがない場合は表示される前にショートカットキーが押下されることがありますので、必ず入れるようにしてください。

Application.Wait (Now + TimeValue("00:00:02"))

タカヒロ
タカヒロ
表示がさらに遅い場合は”00:00:02″の部分を”00:00:04″など増やし、待ち時間を増やして調整をしてください。

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)

タカヒロ
タカヒロ
今回の変更箇所は会議出席依頼の新規作成と変更処理の2か所の変更となります。

VBAを実行する

まずはオレンジの分類を指定して、新規送信をしています。

VBAを実行してみましょう。
はい、オレンジの分類が設定され、オレンジ色になりましたね!

続いて、青の分類に設定してみましょう。

会議通知変更の場合は件名や日付を変えないと送信されませんので、今回は件名を変更します。

VBAを実行してみましょう。

はい、青の分類が設定され、青色になりましたね!

VBAの説明

分類項目を設定する機能について説明をします。

今回使用したプロパティはCategoriesといい、分類項目を設定することができます。

名前 説明
Categories Outlook アイテムに割り当てられた分類項目を表す文字列を設定または返します。 値の取得と設定が可能です。

このプロパティに13列目のM列のセルの値を指定することにより、分類項目を設定することができます。

.Categories = Cells(i, 13)

タカヒロ
タカヒロ
今回はM列に設定しましたが、列の位置は適宜変更頂ければと思います。

さいごに

いかがでしょうか。

今回は

Excelにまとめた会議情報からOutlookの会議出席依頼を送信する方法と、会議内容やスケジュールを変更して再送信する方法

についてまとめました。

Outlookの操作は手作業が多いですからなるべく自動化して効率化を図りたいですね。



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

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




タカヒロ

プログラミングやマーケティングなどに興味あるけど
どのスクールが良いか悩むときはないですか?

タカヒロもスクール選びにとても苦労しました…

そんな時には数ある中から第三者目線でいまの貴方に合ったスクールを提案してくれるスクマドのカウンセリングサービスがおすすめです。

メリットだけでなくディメリットもズバリと伝えてくれます!

これでお悩み時間を短縮できますね!詳細は☟になります。

※完全無料です。ご安心ください。





58 件のコメント

  • 早速のご教示ありがとうございました。
    結局、共有カレンダーを編集するのに会議招集という形をやめ、直接対象カレンダーをエクセルから編集する形にしました。(頂戴したリンクの通り)

    最終的にほとんど全てうまくいったのですが、カテゴリ分類についてうまくいかない部分が発生しました。
    ご教示いただいた方法でカテゴリを分類することにはできたのですが、一度設定したカテゴリに変更を加えようとすると、変更されず元のカテゴリが残ってしまいます。(その他のアイテムは問題なく変更されます)

    一度セットしたカテゴリの変更については、一度カテゴリを消すといったような動作が必要に思えますが、どのようにすれば解決するかご助言をいただけないでしょうか。

    何度もお手数をおかけし恐縮です。どうぞよろしくお願い致します。

    https://extan.jp/?p=2275#%E4%BB%A3%E7%90%86%E4%BA%BA%E3%81%A8%E3%81%97%E3%81%A6%E4%BC%9A%E8%AD%B0%E5%87%BA%E5%B8%AD%E4%BE%9D%E9%A0%BC%E3%82%92%E9%80%81%E4%BF%A1%E3%81%99%E3%82%8B%E5%A0%B4%E5%90%88%E3%81%AE%E8%A8%AD%E5%AE%9A

    • カテゴリが変更できない件につきまして、公開コードでは件名、開始日、終了日の変更の時のみ更新処理が行われる仕様のため、
      カテゴリのみ変更をしたとしても更新はされません。

      カテゴリを変更する場合は変更処理の条件となる件名、開始日、終了日を同時に変更いただくか、
      カテゴリ変更のみでも更新処理が行われるよう、以下のように条件を追加頂きたくお願いいたします。
      ■変更前
      If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then

      ■変更後
      If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End And olItemBefor.Categories = olItem.Categories Then

  • カテゴリ分類の件ありがとうございました。
    頂戴したご対応の速さと丁寧さに大変感動致しました、現状無事うまく分類ができています。

    そこで欲が出てしまい恥ずかしいのですが、もう一点質問をさせていただけますでしょうか。

    このVBAで会議招集を送信する際、送信元のアカウントを指定するにはどうすればいいでしょうか。
    現在Outlookで2つのアカウントを使用しているのですが、会議招集の送信元は自動的に一つ目のアカウントとなります。VBAによる会議招集の送信元を二つ目のアカウント(メールアドレス)に指定すること可能でしょうか。

    というのも、二つあるアカウントは、①個人アカウント②チームで共有して使っているアカウントです。この②に会議招集を送ることで②のカレンダー内でチームスケジュールを管理しようと思い、こちらのサイトにたどり着きました。

    ただカテゴリ分類については送信元のカレンダーでしか反映されないということに気が付き(当然ですが)、②を送信元とする必要があると考えました。
    ご面倒をおかけしますがご助言をいただけますと幸甚です。宜しくお願い致します。

  • 素晴らしい記事をありがとうございます。
    実際に使用させていただき業務がスムーズになりました。

    当方VBA初心者で恐縮ですが一点質問があります。
    会議招集にカテゴリ分類をつけることは可能でしょうか、またそれどのようにすればいいでしょうか。

    現在チームの共有カレンダーにこちらのVBAで会議招集を送ることでチームスケジュールを自動でアップデートしているのですが、可能であればカテゴリ分類により色で識別しやすくしたいと思い、頭を悩ませています。

    ご助言をいただけますと幸甚です。

  • お疲れ様です。
    このVBAとても素晴らしいと思います。
    1点質問ですが、
    Outlookに登録してもTeamsのカレンダーに会議用のURLが発行されていないためTeams会議をすることが出来ません。
    Teams会議のURLの発行は不可能なのでしょうか?
    Outlookのスケジュール登録の際に、上のタブには『Teams会議』のアイコンがあるので、クリックするだけなのですが、記録でやってみても何も出てこず…

  • 有用な記事ありがとうございます。
    こちらのエクセルからの送信においてTeamsでの招集も同時に行う方法をご教示いただけないでしょうか。
    よろしくお願いします。

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

      VBAでTeamsでの招集(会議通知)を行う件につきまして、
      VBAでTeamsを操作することはできかねますが、
      TeamsスケジュールはOutlook側の予定表とデータが同期されていますので、
      Outlookにて会議通知を行えば結果としてTemasスケジュールへ登録される形になります。

      ご参考ください。

  • お世話になっております。
    やはり返信ボタンが押せないため、こちらから失礼いたします。度々本当に申し訳ありません…

    いただいたURLをもとに組み合わせようとしているのですが、
    差出人は意図した他人(=自身の違うアカウント)になったものの、会議出席依頼のメールが参加者に送信できないため予定が反映されず、差出人のみの予定に反映される状態です。

    ‘操作対象の他人のアドレスを指定
    Dim strAddress As String
    strAddress = “hanako@extan.jp”
    →ここで入れたアドレス=差出人という認識なのですが、この関係で差出人の予定にしか反映されないのかと思っています。

    複数名に同じ差出人(自身の別のアカウント)からそれぞれ違う予定を送信したく、
    下記を織り交ぜるのかと思い、タカヒロ様の他の記事もふまえて試してみているのですが上手くいきません。。
    (取得する予定表の情報を自分ではなく他人に変える必要がある?=MAPI部分の変更が必要?)
    https://docs.microsoft.com/ja-jp/office/client-developer/outlook/pia/how-to-display-a-shared-calendar-of-a-recipient
    https://extan.jp/?p=2620#Namespace%E3%82%AA%E3%83%96%E3%82%B8%E3%82%A7%E3%82%AF%E3%83%88%E3%81%A8GetNamespace%E3%83%A1%E3%82%BD%E3%83%83%E3%83%89%E3%81%A8%E3%81%AF%EF%BC%9F

    お忙しい中申し訳ありませんが、解決策がありましたらご教示いただけますと幸いです。
    よろしくお願いいたします。

    • ご連絡ありがとうございます。
      ※返信ボタンについてわかりにくくすみません。クリック後コメント欄へ記載いただければ機能致します。

      代理人への登録はされるが送信はされない件につきまして、以下をご確認頂けますでしょうか。

      ・必須/任意出席者にアドレスが指定されているか
      .RequiredAttendees = Cells(i, 6)
      .OptionalAttendees = Cells(i, 7)
      対象セルにメールアドレスが含まれているか確認をお願いします。

      ・.Saveは外れているか
      SaveメソッドがSendメソッドの前にあると保存が優先される形になりますので、
      Sendメソッドのみの記述に変更してください。

      ・代理人のメールボックスの送信トレイに蓄積されていないか
      即時送信をOFFにしていて代理人メールボックスの送信トレイに対象通知がたまった状態であれば手動で送信頂きたくお願いします。

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

  • お世話になっております。
    先日別記事にて質問させていただきました。(返信ボタンが使用できず、御礼が遅くなってしまい申し訳ありません。ありがとうございました!)

    いただきましたように今回の記事にてVBAを作成しているのですが、
    予約者を自身でなくアクセス権限がある他者にしたく(会議出席依頼で送付された予定を、グループで管理してるアクセス権限がある予定表に反映させたい)、そのようなVBAを組むことは可能でしょうか…

    こちらをもとに考えているのですが、途中でエラーが出てしまって上手くいかず…
    https://docs.microsoft.com/ja-jp/office/vba/api/outlook.namespace.getshareddefaultfolder

    お忙しい中お手数ですが、可能でしたら教えていただけますと幸いです。
    よろしくお願いいたします。

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

      予約者をアクセス権限がある他者から送信する方法につきまして、
      以下の記事が近い内容かと存じますので、ご参考ください。

      https://extan.jp/?p=2275
      ※「代理人として会議出席依頼を送信する場合の設定」と組みあわせてください。

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

  • お世話になっております。
    先日別のページにて質問させていただいたものです。
    返信するボタンが押せず御礼が遅くなってしまい、申し訳ありません。その節はありがとうございました!

    重ねて質問をしてしまって申し訳ないのですが、こちらのVBAだと予約者が自分で自動的に反映されるかと思います。
    代理人アクセル権限のある予定表から登録がしたい=予約者を他人にしたい場合、方法はありますでしょうか。
    こちらを使うのかなと個人的に思っているのですが上手く組み合わせられず…
    https://docs.microsoft.com/ja-jp/office/vba/api/outlook.namespace.getshareddefaultfolder

    多くの予定を登録するつもりなので自身の予定表をひっ迫したくなく、
    かつ共有用に代理人アクセス権限がある他者の予定表を使用したく、ご相談させていただけますと幸いです。
    お忙しい中お手数おかけいたしますが、よろしくお願いいたします。

  • ありがとうございました。
    ご教示いただいたもので希望通りの動作が確認できました。

  • こちらのサイトを見てVBAを勉強させていただいたおります。

    会議予定ではなく、お客様とのアポイントの管理に応用したいと思い、試行錯誤しておりますが、日付の部分で躓いております。

    あらかじめお客様の情報が記載されたシートがあり、アポが取れたら日付と時刻を入力しています。
    VBAで使用するために同じブックの別シートにお客様名やアポの日時などを関数で抜き出しています。
    開始時刻は=IF(Sheet1!A2=””,””,Sheet1!A2+Sheet1!A3)としていますが、アポをとる前のお客様のところでエラーコード13となってしまいます。

    コメントにあった.Start = Format(Cells(i, 3).Value, “yyyy/mm/dd hh:mm:ss”)もうまくいかず、行き詰っております。
    お知恵を拝借できれば幸いです。
    開始時刻とは別のセルに=A2として、こちらを指定してみましたが、結果は同じでした。

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

      エラー13が表示される件につきまして、
      開始日時に指定している値が日付型以外であることが原因かと思われます。

      開始時刻をSheet1シートA列の値の有無で判定し計算されていますが、
      A列の値が無い場合では開始時刻の値に空値が設定され、VBA側で受け取った際には
      日付型にマッチしない値と判断され、エラー13となります。

      対応としては、開始日時が空の場合は登録処理を行わないように変更を加えます。

      ■変更前
      ‘EntryIDが空である場合のみ新規登録をすることにしました。
      If checkFlg <> 1 And Cells(i, 9) = “” Then

      ■変更後
      ‘EntryIDが空かつ、開始日時が空でない場合のみ新規登録します。
      If checkFlg <> 1 And Cells(i, 9) = “” And Cells(i, 3).Text <> “” Then

      ご確認の程お願いいたします。

  • ご返信ありがとうございます。

    出席者に既に予定がある場合メールを送信したくないと記述した意図なのですが、会議室の予約を行いたいと思っている為です。

    そのため複数のスケジュールを自分がつけた優先順位順に参照して、既に予定が入っている宛先(この場合は会議室)は除外して優先順位が高い初めに予定が空いている宛先にメールを送りたいと考えておりました。

    個人的にも調べてみたのですが、FreeBusy メソッドを使うのが一番シンプルなのかなとも思いましたが、イマイチ使い勝手が悪くて難航しておりました。
    https://ts0818.hatenablog.com/entry/2020/07/22/223220

    また、「OlBusyStatusオブジェクトから予定の有無を確認し」とのことで自分も検討してみたのですが、時間の指定方法が分からず断念してしまいました。

    コードを検証していただけるとのことで、大変ありがたいです。
    もし、うまくいったら是非公開お願いいたします。

    ありがとうございました。

  • とても素晴らしいマクロありがとうございます。
    ご質問なのですが、設定した会議が他人の会議に被ってしまう場合を判別し被った場合送信をしないようにしたいのですが、どのように変更をすればいいのかをご教授願いたいです。

    具体的には、outlookの会議通知を送信するタブにあるスケジュールアシスタントを取得し予定が被っている出席者にはメールを送らないようにしたいと考えております。

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

      予定が被っている出席者にはメールを送らないようにする方法につきまして、
      スケジュールアシスタントとしてまとまっている機能はないため、
      出席者の同一時間帯の予定チェックと出席者を変更する仕組みを
      モジュールとして独立して作り込む必要があるかと存じます。

      ざっと思いつく限りですと、出席者リストを分割し、
      GetSharedDefaultFolderメソッドで出席者の予定アイテムを取得し、
      OlBusyStatusオブジェクトから予定の有無を確認し、
      ない場合に送信者リストへ追加し、送信という流れになるかと存じます。

      コード作成後検証を行い、うまくできた場合には記事に追加しようと思っております。

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

  • 大変お世話になっております。
    分からないので教えてください。

    フィルターをかけた後の可視セルのデータ分だけ出席依頼をかけたいのですがどのようにしたら良いかご教示おねがいします。

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

      ご質問の見えているセルのみ出席依頼対象(非表示の行は対象外)とする方法につきまして、
      以下のように記事のコードに判定処理を加えることにより可能となります。

      ■変更前
      ‘予定表一覧の件数分繰り返します。
      For i = lnContactCount To Cells(1, 1).End(xlDown).Row
      ・・・
      Next

      ■変更後
      ‘予定表一覧の件数分繰り返します。
      For i = lnContactCount To Cells(1, 1).End(xlDown).Row
      ‘非表示の行はスキップします。
      If Rows(i).Hidden = False Then
      ・・・
      End If
      Next

      Rows(i).Hiddenにて対象行が表示/非表示かを判定し、表示されている場合のみ出席依頼処理をかけるようにしております。

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

  • ご返信ありがとうございます。2点やってみましたが、変わらずでした。以下のようにエラーがでます。

    ‘EntryIDが空である場合のみ新規登録をすることにしました。
    If checkFlg 1 And Cells(i, 9) = “” Then
    With olItem
    .Subject = Cells(i, 1)
    .Location = Cells(i, 2)
    .Start = Format(Cells(i, 3).Value, “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

    ここのstart以下が黄色く表示されます。なお、スケジュール登録はOutlookのほうで正常に行われています。
    また、開始日時のセルには=IF(ISNUMBER(‘22.1′!C10),DATE(2022,1,’22.1′!A10)+’22.1’!C10,””)という関数が入っております。(22.1はシート名です。)

    ほかに何か解決策はございますでしょうか。大変お忙しいところ恐縮ですがご返信いただければ幸いです。

    • 変わらずということは別のところに原因がありそうです。

      まず関数については数字判定してData関数で日数を加算している処理で結果はシリアル値が返されますので問題ないと思います。
      気になったのはOutlook側で正常にスケジュール登録されているということです。

      おそらくですが、関数の判定でFalseとなっているセルやExcelのスケジュールテーブル外のセルを参照してしまっている可能性がありますので、
      エラー発生時に変数iが何番になっているか、またC列i行目のセルの値が何になっているか確認頂けますでしょうか。

      もしi行目がテーブル外になっていたら、以下のA列最終行「Cells(1, 1).End(xlDown).Row」をテーブルの最終行数(10行目であれば「10」)に変更頂けばと存じます。
      For i = lnContactCount To Cells(1, 1).End(xlDown).Row

      関数の判定でFalseとなっているセルが含まれる場合は、
      以下を参考にエラーを無視するよう設定頂ければと存じます。
      https://extan.jp/?p=3575#%E2%91%A2%E8%AB%96%E7%90%86%E3%82%A8%E3%83%A9%E3%83%BC
      ※「OnErrorResume Next」をVBAのコードの中に入れるだけです。

  • 追記しますと、開始日時はIF関数で別のシートから日付を抽出したものをユーザー定義で”yyyy/mm/dd hh:mm:ss”形式にしております。

    • 実行時エラー13につきまして、文字列が日付型として認識されず、シリアル値へ変換できないことが根本原因となります。
      以下ご確認いただいてもよろしいでしょうか。
      ①開始日時がカレンダーにない日付や時刻を指定していないか(例えば2022/2/29、0:61:00など)
      ②Valueプロパティをつけて実行してみる .Start = Format(Cells(i, 3).Value, “yyyy/mm/dd hh:mm:ss”)

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

  • コメントを残す

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