【Excel VBA】一瞬でExcelワークシートからOutlookの予定表へスケジュールを登録する

Outlookの予定表で予定を登録する機会は多いかと思います。

そんな中で面倒なことは、

・Outlookへ一括で予定を登録する方法はない?
・ExcelでまとめたスケジュールをOutlookに一括登録するにはどうすればよい?

ではないでしょうか?

今回は、
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 olItem  As AppointmentItem
    
    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    
    Dim lnContactCount As Long
    
    'スクリーンの更新は行われません。
    Application.ScreenUpdating = False
    
    'Excelのブックとワークシートのオブジェクトを設定します。
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(1)
    
    
    wsSheet.Activate
    
    'Outlookオブジェクトを設定し、MAPI名前空間を介してOutlookの予定表を取得します。
    Set olApp = New Outlook.Application
    
    
    '取得結果を記述する行番号を指定します。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)
            
            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, 6)
                .OptionalAttendees = Cells(i, 7)
                
            End With
            
            'ここで保存
            olItem.Save

        Next
    
    Else
        MsgBox "処理を中断します"
    End If
    
    'Null out the variables.
    Set olItem = Nothing
    Set olApp = Nothing
    
            
    'Turn screen updating back on.
    Application.ScreenUpdating = True
    
    MsgBox "Outlook予定表の登録が完了しました!", vbInformation
    
End Sub

実装手順は以下の通りです。今回はExcel側にこのVBAを実装します。
①Excelを新規に開き、「開発」タブをクリックし、「VisualBasic」をクリックします。
もしくはショートカットキー「Alt」+「F11」でもOKです。

②標準モジュールを追加します。
左ペインのVBAProjectを右クリックし、「挿入」、「標準モジュール」を選択します。

③右ペインのウインドウに上記のマクロを入力します。

こちらで完了です。


VBAを実行する

①データを準備します。
サンプルでは前回取得したデータを元に、「開始日時」と「終了日時」に変更を加えています。

手動で入力する際には以下の項目に沿って記入をしてください。

タカヒロ
タカヒロ
特に「開始日時」と「終了日時」の形式に入力間違えがないように注意してください。

件名 場所 開始日時 終了日時 予定の本文 必須出席者 任意出席者
件名を入力 場所を入力 開始日時を”yyyy/mm/dd hh:mm:ss”形式で入力 終了日時を”yyyy/mm/dd hh:mm:ss”形式で入力 予定の本文を入力 必須出席者のアドレスを入力 任意出席者のアドレスを入力

②「開発」タブの「マクロ」をクリックし「Outlookの予定表へ登録する」を選択し、「実行」をクリックします。

③Outlookの予定表へ登録されたら完成です!

念のためスケジュール表の中身も見てみましょう。
スケジュールの各項目も反映されていますね。

なお、今回は仕様上会議出席者を指定しても出席者へ連絡がされません。
また、2回同じ情報で登録した場合は、既存のスケジュールを変更するのではなく追加となりますのでご注意ください。

2回実施した場合はこうなります。

タカヒロ
タカヒロ
やっぱり予定アイテムの重複は困るよとの意見があり、重複スキップ版を作成してみました。1点目は件名と開始日時で重複判定、2点目は予定IDで判定し、更新も可能にしてみました。

予定アイテム重複スキップ版追加

予定表の中で、これから登録する件名と開始日時が登録済み予定アイテムと一致していたら
処理をスキップする処理を追加しました。

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
    
    'スクリーンの更新は行われません。
    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
    
    '取得結果を記述する行番号を指定します。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)

            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, 6)
                .OptionalAttendees = Cells(i, 7)
                
                '重複チェック
                For Each olItemBefor In olConItems
                    If TypeName(olItemBefor) = "AppointmentItem" Then
                        '登録されている予定表の件名と開始日時が一致していたらフラグを1にする
                        If olItemBefor.Subject = .Subject And olItemBefor.Start = .Start Then
                          checkFlg = 1
                        End If
                    End If
                    
                Next

                If checkFlg <> 1 Then
                    'ここで保存
                    olItem.Save
                    
                End If

            End With
            
            '重複フラグリセット
            checkFlg = 0

        Next
    
    Else
        MsgBox "処理を中断します"
    End If
    
    'Null out the variables.
    Set olItem = Nothing
    Set olApp = Nothing
    
            
    'Turn screen updating back on.
    Application.ScreenUpdating = True
    
    MsgBox "Outlook予定表の登録が完了しました!", vbInformation
    
End Sub



予定アイテム重複スキップ&既存予定アイテム更新機能追加

予定表の更新をエクセルからできるようにしました。

タカヒロ
タカヒロ
今までは新規登録のみでしたが、登録した既存予定アイテムの更新を可能にしたわけです。

新規登録の場合はOutlook予定表に登録され、エクセルのI列に予定アイテムのIDが登録されます。
更新の場合はその予定アイテムのIDと一致した場合に実施されるようにしました。

なお、タイトル、開始日、終了日が変更された場合のみ更新という条件となっていますので、
出席者や本文など変更した場合も更新したい場合は

If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then

こちらのif文の条件を緩和してください。

なお、if文を外すと問答無用にエクセルリスト分の予定アイテムが更新されますのでご注意ください。

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
    
    'スクリーンの更新は行われません。
    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
    
    '取得結果を記述する行番号を指定します。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
                    
                        'エクセルI列の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
                        
                            '登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新
                            '※更新の条件はご都合に応じて変更してください。この条件が無い場合はエクセルの予定表すべて更新されますので、ご注意ください。
                            If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then
 

                            Else
                                 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, 6)
                                    .OptionalAttendees = Cells(i, 7)
                                    .Save
                                End With
                            End If
                            
                                'Null out the variables.
                                Set olItem = Nothing
                            
                        End If
                    

                    End If
                    
                Next

                If checkFlg <> 1 Then
                    'エクセルI列のEntryIDと登録されているEntryIDが一致していなかったら新規登録
                    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, 6)
                        .OptionalAttendees = Cells(i, 7)
                        .Save
                   End With

                   'エクセルI列へ発行されたEntryIDを書き込み
                   Cells(i, 9) = olItem.EntryID
                    
                End If

            
            '重複フラグリセット
            checkFlg = 0

        Next
    
    Else
        MsgBox "処理を中断します"
    End If
    
    'Null out the variables.
    Set olItem = Nothing
    Set olApp = Nothing
    
            
    'Turn screen updating back on.
    Application.ScreenUpdating = True
    
    MsgBox "Outlook予定表の登録が完了しました!", vbInformation
    
End Sub

タカヒロ
タカヒロ
複数ユーザで登録する場合は予定ID(EntryID)が重複したり更新されますので、1ユーザのみで利用するようお願いします。

複数ユーザの予定情報をワンクリックで取得したい方はこちらをご参照ください。
【Excel VBA】一瞬で複数ユーザのOutlook予定表をExcelへ取り込む方法!



予定アイテム更新処理<高速版>

エクセルから予定表の更新を行う処理に2~3分時間がかかってしまうとのご意見がありましたので、
処理方法を見直した高速版を公開します。

今までは予定アイテム全件のIDをチェックしていましたので、Outlook利用歴が長い方や密にスケジュールを入れている予定アイテム総数が多い方は処理時間がどうしてもかかってしまいます。

そこでIDをチェックする範囲を期間で絞り込み、予定アイテム数を少なくすることによって、処理を軽減させていきます。

タカヒロ
タカヒロ
多忙な方ほど処理時間が長くなってしまうということでエク短的に改善必須でしたね…

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
                
                    'エクセルI列の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
                    
                        '登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新
                        '※更新の条件はご都合に応じて変更してください。この条件が無い場合はエクセルの予定表すべて更新されますので、ご注意ください。
                        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, 6)
                                    .OptionalAttendees = Cells(i, 7)
                                    .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, 6)
                    .OptionalAttendees = Cells(i, 7)
                    .Save
               End With
    
               'エクセルI列へ発行されたEntryIDを書き込み
               Cells(i, 9) = olItem.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

設定してもらいたい箇所は以下の数値の箇所です。

ここでは対象予定表の抽出期間を月単位で指定します。
intKikan = 12

サンプルでは抽出期間を12か月に設定しているという意味となり、
この場合、12か月前から12か月後の予定アイテムが対象となるわけです。

[抽出開始]<—-12か月間—->[現在]<—–12か月間—->[抽出終了]

これまではOutlookの予定アイテムがある期間分取得していましたので、

人によっては膨大な予定アイテム数になってしまうわけですが、

期間指定により期間外の予定アイテムは除外されるので、対象予定アイテム数が絞られるという仕組みになります。

タカヒロ
タカヒロ
こちらの環境で検証したところ、12か月指定で1分、6か月指定で数十秒、1か月指定だと一瞬で完了します。Outlook利用歴の長い方ほど効果がでると思います。

なお、期間を短くすればするほど比例して処理時間も短くなりますが、
その分更新漏れのリスクが生じますのでご注意ください。



さいごに

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

Excelの予定一覧から他人のOutlook予定表を登録、編集する方法

他人のOutlook予定表をExcelワークシートへ取り込む方法

【Excel VBA】先月、今月、翌月分のOutlook予定表データをワンクリックで取り込む

24 件のコメント

  • お世話になります。
    重複した場合の設定などご教示いただけませんでしょうか?
    例えばその場合は作業を停止するなど

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

      重複した場合の設定についてですが、重複フラグを設け、
      予定表の件名と開始日時が一致していたらフラグを1にし、
      その場合は予定表の登録をスキップする処理にしてみました。
      また、記事本文にも追記させ頂きました。

      ご査収の程お願いいたします。

      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

      ‘スクリーンの更新は行われません。
      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

      ‘取得結果を記述する行番号を指定します。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)

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

      ‘重複チェック
      For Each olItemBefor In olConItems
      If TypeName(olItemBefor) = “AppointmentItem” Then
      ‘登録されている予定表の件名と開始日時が一致していたらフラグを1にする
      If olItemBefor.Subject = .Subject And olItemBefor.Start = .Start Then
      checkFlg = 1
      End If
      End If

      Next

      If checkFlg <> 1 Then
      ‘ここで保存
      olItem.Save

      End If

      End With

      ‘重複フラグリセット
      checkFlg = 0

      Next

      Else
      MsgBox “処理を中断します”
      End If

      ‘Null out the variables.
      Set olItem = Nothing
      Set olApp = Nothing

      ‘Turn screen updating back on.
      Application.ScreenUpdating = True

      MsgBox “Outlook予定表の登録が完了しました!”, vbInformation

      End Sub

  • 本日、はじめ活用させていただいたところ、Outlookにしっかり反映されました!
    ありがとうございます。

    一つ質問なのですが、会議日時が変更になった際、前の会議設定を消して、新たな会議設定を入れる(連動させる)ことは可能でしょうか?

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

      一度登録した会議設定を更新(連動)することは可能です。

      会議設定をするとOutlook側ではその会議に対してID(EntryIDと呼ばれます)が発行されますので、
      更新の際はそのIDを手掛かりに会議設定をおこなうという流れとなります。

      以下のマクロは本文のエクセルのリストから会議設定を行うものに対して、エクセルのI列に新規会議の場合はIDをI列に追記、更新の場合はI列のIDをみて該当するIDの会議設定を行うように処理を加えたものです。

      一度サンプルで新規登録から変更(タイトル、開始日、終了日)まで試していただければと存じます。

      なお出席者や本文単体の更新はできませんが、変更したい場合は以下のif文の条件を緩和してみてください。
      If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then

      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

      ‘スクリーンの更新は行われません。
      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

      ‘取得結果を記述する行番号を指定します。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

      ‘エクセルI列の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

      ‘登録されている予定表の件名と開始日時及び終了日時が一致していなかった場合のみ更新
      ‘※更新の条件はご都合に応じて変更してください。この条件が無い場合はエクセルの予定表すべて更新されますので、ご注意ください。
      If olItemBefor.Subject = olItem.Subject And olItemBefor.Start = olItem.Start And olItemBefor.End = olItem.End Then

      Else
      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, 6)
      .OptionalAttendees = Cells(i, 7)
      .Save
      End With
      End If

      ‘Null out the variables.
      Set olItem = Nothing

      End If

      End If

      Next

      If checkFlg 1 Then
      ‘エクセルI列のEntryIDと登録されているEntryIDが一致していなかったら新規登録
      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, 6)
      .OptionalAttendees = Cells(i, 7)
      .Save
      End With

      ‘エクセルI列へ発行されたEntryIDを書き込み
      Cells(i, 9) = olItem.EntryID

      End If

      ‘重複フラグリセット
      checkFlg = 0

      Next

      Else
      MsgBox “処理を中断します”
      End If

      ‘Null out the variables.
      Set olItem = Nothing
      Set olApp = Nothing

      ‘Turn screen updating back on.
      Application.ScreenUpdating = True

      MsgBox “Outlook予定表の登録が完了しました!”, vbInformation

      End Sub

      ご査収の程、お願いいたします。

      • お礼が大変遅くなり、申し訳ありません。
        無事に更新できるようになりました!

        追加で申し訳ないのですが、上記のプログラムの動作を軽くすることは可能でしょうか?
        いろいろ自分でも試しているのですが、どうしても1回、2~3分程度かかってしまいます…。

        • 本記事の「予定アイテム更新処理<高速版>」へサンプルを掲載しましたので、よかったらご参考ください。

          • 高速化、ありがとうございました!
            無事にすることができました!
            毎回、お礼がおそくなり申し訳ありません…。

            自分でもできるように、勉強します!

        • お役に立ててうれしく思います!

          処理時間が2~3分かかってしまう件ですが、予定IDをチェックするときに登録されている予定表の予定アイテムをすべて確認する処理を行うため、
          Outlookを何年も使っている方や、予定を密に入れられている方など予定アイテムを多く保持している方は処理時間が長くなってしまう傾向があります。

          現在、処理時間の短縮を図るために対象期間を絞るなどしてチェック対象を少なくできないか検討中ですので、
          お待ちいただきたくお願いいたします。

          • お手数をおかけし、申し訳ありません。
            自分の勉強不足を実感しております…。

            ちなみに予定は最大でも前後2週間程度しかずれません。

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

  • 一つ質問させてください。
    このExcelを複数人で共有して使用したいと考えています。
    その際に、予定の更新をExcelから行うことは可能なのか教えてください。
    更新の場合には、「予定アイテムのID」を利用する設定になっていると思いますが、
    この「予定アイテムのID」は各ユーザーによって同じスケジュールでも登録IDが違うのではないかと思っています。
    その場合、一つのExcelを使ってうまく更新をする手立てはありますでしょうか?
    お手数ですがご教示いただければ幸いです。

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

      複数人でExcelから予定の更新を行うことは可能かのご質問ですが、
      結論としては使い方次第で可能となります。

      ご注意いただきたいことは更新をする場合は、
      予定表の最新の情報を取得した上で行うようにすることです。

      ご認識の通り「予定アイテムのID」は異なる値がOutlook側で発行されますので、同じスケジュールであったとしても
      新規予定として追加されてしまいます。

      これを避けるためにもOutlook予定に登録されている「予定アイテムのID」を常に取得頂く必要があるというわけです。

      本記事でご紹介させて頂いているVBAは予定新規登録後に「予定アイテムのID」を取得する処理を加えていますので、
      複数人で使う場合でも、このVBAを実装したExcelを単体で共有して使う分には問題はありません。

      例えば共有ファイルサーバにExcelを格納し、複数人が共有ファイルサーバー経由でExcelを参照するといった使い方です。

      避けて頂きたいのは複数の方がそれぞれのPCでExcelを持って共有の予定を更新するやりかたです。
      この場合には予定登録前に最新の「予定アイテムのID」を取得頂く必要があります。

      ご検討の程お願いいたします。

      • ご回答ありがとうございます。
        1つのBookをファイルサーバー等で共有して使う場合には問題ないということでしたが、
        例えば最初の1人目が新規でOutlookへ登録をすると、そこで発行されたIDがExcelに書き込まれると思います。
        次に2人目がそのExcelを使って同じ予定を新規でOutlookに登録しようとした場合、既にExcelに書かれているIDと比較をすることになると思うのですが、そこで2人目のOutlookから取得したID上にはExcelのIDが存在しないので、Excelに書かれている1人目が発行したIDで2人目のOutookへ登録がされる、という理解で合っていますか?

        ちなみに、1人目が発行したIDが2人目の既に登録されている別予定のIDと偶然に一致してしまうという事はありえないでしょうか?IDの附番ルールがわかっていないので合わせて教えていただければと思います。

        お手数ですがよろしくお願いします。

        • お手数ですが、Outlookの利用環境を確認させて頂きたく、

          複数人がご利用ということですが、例えばユーザAはユーザAの予定表、ユーザBはユーザBの予定表へ、共有しているエクセルのスケジュール表から登録するということでよろしいでしょうか。

          前回回答させて頂いた内容は一つの共有予定表を複数人で使うことを前提としておりましたので、上記の構成でしたら訂正をさせてください。

          ご質問の
          >Excelに書かれている1人目が発行したIDで2人目のOutookへ登録がされる、という理解で合っていますか?
          についてですが、上記のユーザそれぞれの予定表へ登録する場合はご認識の流れで処理が進みますが、
          実行ユーザのOutlook予定表内の予定IDを検索し合致していれば更新するという条件がありますので、
          エクセルにIDがあったとしてもOutlook上の予定IDと不一致であれば新規予定として登録され、エクセル側は2人目のIDに変更される形となります。

          >1人目が発行したIDが2人目の既に登録されている別予定のIDと偶然に一致してしまうという事はありえないでしょうか?
          予定のIDの発番ロジックについて把握しておりませんので確約は出来かねますが、同じロジックで発番され、それぞれのOutlookで保持しているIDであるため、
          重複する可能性はないとは言えないというところでしょうか。

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

          • 色々とご回答いただきありがとうございます。
            1つのExcelで変更処理まで行おうと思うとかなり複雑になりそうなので、運用方法を少し考えて対応してみたいと思います。
            お力添え頂きありがとうございました。

          • ご連絡遅くなりましたが、
            以下に1つのExcelで複数ユーザの予定を編集する方法をまとめましたので、
            よろしければご参考ください。
            https://extan.jp/?p=2849

          • 承知いたしました。

            複数ユーザの予定変更マクロは別の機会にでも公開したいと考えていますので、
            よかったらご参考頂ければと思います。

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

            複数ユーザの予定更新

          • ご回答ありがとうございます。

            利用環境としては、ユーザAはユーザAの予定表、ユーザBはユーザBの予定表へ、共有しているエクセルのスケジュール表から登録、という形になります。

            ご回答内容からすると、
            Outlook予定表内のIDとExcelのIDは常に不一致となるので、常に新しく予定が登録されてしまう。
            そして、Excelに元々書かれているIDで登録されるわけではなく、新たにその個人のOutlookが発番するIDで登録される。
            よって、現在の仕組みだと1つのExcelを共有して複数ユーザー毎の予定表に更新をさせるという事はできなさそう、という理解になりますでしょうか。

            ちなみに、各ユーザーが登録を行う前にそのユーザーの現在登録されているスケジュールIDを取得してそれをExcelに反映させてから、新規登録及び更新作業を行うといった手順を踏む作りにすることは可能なのでしょうか?

            何度もお手数ですがご確認お願いします。

          • 複数ユーザのOutlook予定表をExcelへ取り込む方法についてまとめましたので良かったらご参考ください。
            https://extan.jp/?p=2802

            上記の表を利用したExcelからの複数ユーザの予定表の編集は検証をしており、公開する予定です。

          • >現在の仕組みだと1つのExcelを共有して複数ユーザー毎の予定表に更新をさせるという事はできなさそう、という理解になりますでしょうか。

            ご認識の通り、1つのExcelシートで複数ユーザの予定を管理することは、予定のIDが重複、不整合が生じますので現在の仕様では難しいものと思われます。
            もし行うとすればメールアドレス等でユーザを識別する項目を追加し、ユーザ毎に処理を行う必要があります。

            >各ユーザーが登録を行う前にそのユーザーの現在登録されているスケジュールIDを取得してそれをExcelに反映させてから、新規登録及び更新作業を行うといった手順を踏む作りにすることは可能なのでしょうか?
            こちらの機能は実現可能です。

            指定ユーザーの現在登録されているスケジュールIDを取得する方法については
            以下の記事をご参照ください。
            https://extan.jp/?p=2243

            ※指定ユーザではなく実行ユーザの規定のメールボックスを対象にする場合は以下のようにコードを変更してください。

            ‘以下3点をコメントアウトします。
            ‘Set recOther = olNamespace.CreateRecipient(strAddress)
            ‘Set olFolder = olNamespace.GetSharedDefaultFolder(recOther, olFolderCalendar)
            ‘Set olConItems = olFolder.Items

            ‘こちらを追記します。
            Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)
            Set olConItems = olFolder.Items

            実行タイミングはマクロ実行ボタンを設置しユーザ側で操作するか、Excelブックを開いたときなどVBAイベントで実行する方法があるかと思います。
            その上で最新情報を取得し、

            ユーザの予定表を更新するには、実行ユーザの規定のメールボックスの場合は本記事のマクロか、指定ユーザの場合は以下の記事のマクロで実行頂く形になるかと思います。
            https://extan.jp/?p=2275

            ただこちらも一つのExcelシートで1ユーザの予定を管理することを前提としておりますので、
            複数ユーザの予定情報を管理する場合はシートやブックを分けたほうがよいでしょう。

  • 上記のvba、ありがとうございます。
    更新、高速化共に実感でき、業務の効率化にも役立っております。
    本当にありがとうございます。

    一つ確認なのですが、
    上記のvbaにて、会議設定を相手にすぐに飛ばすことは可能でしょうか?
    Outlookの会議開き、送信する手間が無くなればなと考えております。

    ご検討よろしくお願い致します。

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

      会議設定をすぐにメール送信する件ですが、Sendメソッドを利用することで実現可能で、
      コードの中のSaveメソッドをSendメソッドに置き換えるだけでOKです。

      具体的には以下のようにします。
      ‘.Save
      .Send ‘メール送信

      なお、即送信となりますので、事前にテストをされることをおすすめいたします。

      以下はオプションとなりますが、
      送信前にウインドウを表示する場合は、
      Displayメソッドを追加します。
      ‘.Save
      .Display ‘ウインドウを表示
      .Send ‘メール送信

      ドメインに参加しているアドレスであれば、Recipients.ResolveAllメソッドで
      受信者の名前解決ができるかチェックができます。
      例えば退職者等アドレスが存在しない場合にアラートを発生させることができます。
      ‘.Save
      .Recipients.ResolveAll ‘受信者の名前解決をする
      .Display ‘ウインドウを表示
      .Send ‘メール送信

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

      • 回答ありがとうございます。

        本日試したのですが、結果的にはまだすぐに会議設定を飛ばすことができておりません…。

        saveをsendに変更とのことですが、上記vbaの2ヶ所のsaveをsendに変更で間違いないでしょうか?

        またもしかしたら、Outlookで予定をいれるプログラムと会議設定をするプログラムは違ったりするでしょうか?

        こちらの使用環境が原因の可能性もありますよね…。

        またタイミングがいい時に返答を頂けると助かります。

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

  • すごく便利そうなので使用してみたいと思い手探りでやっておりました。
    VBAを実行したところコンパイルエラーがでます。
    解決方法はありますか?

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

      コンパイルエラーということですが、Outlook Object Libraryの参照設定がされていない可能性がありますので

      参照設定をご確認いただけますでしょうか。

      手順は、本記事内「Excel VBAからOutlookを操作するための下準備」の内容を
      ご参照頂きたくお願いいたします。

  • コメントを残す

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