【VBA】一瞬でExcelのスケジュールをOutlookの予定表へ登録/変更する方法

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

そんな中であったらいいなと思うことは、

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

ではないでしょうか?

今回は、あると便利な

・Excelにまとめたスケジュール一覧をOutlook予定表へ一括登録する方法
・ExcelからOutlook予定表のスケジュールを変更する方法
・ExcelからOutlook予定表へ終日の予定を登録する方法

についてまとめます!

Excelにまとめたスケジュール一覧をOutlook予定表へ一括登録する処理の方法について

Excelにまとめたスケジュール一覧をOutlook予定表へ一括登録する処理の方法について説明をします。

Excelにまとめたスケジュール一覧は以下のようにします。

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

 

マクロを実行すると、

Outlookの予定表へExcelにまとめたスケジュールが登録されます!

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

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

実行することで、Excelのスケジュールデータを一件づつ取り出しOutlookの予定表へ登録する流れとなります。

Excelブック(VBA) → 予定表へスケジュールを登録して → Outlook
Excelブック ← スケジュールを登録したよ ← Outlook

まとめてスケジュールを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
    Dim i 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 "処理を中断します"
        Exit Sub
    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 olItemBefor As AppointmentItem
    Dim checkFlg As Long
    
    '重複チェックフラグ初期値設定
    checkFlg = 0
    
    
    
    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    
    Dim lnContactCount As Long
    Dim i 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 "処理を中断します"
        Exit Sub
    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からできるようにしました。

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

新規登録の場合はOutlook予定表に登録され、ExcelのI列に予定アイテムのIDが登録されます。

<tr”>件名を入力場所を入力開始日時を”yyyy/mm/dd hh:mm:ss”形式で入力終了日時を”yyyy/mm/dd hh:mm:ss”形式で入力予定の本文を入力必須出席者のアドレスを入力任意出席者のアドレスを入力空欄EntryIDが自動で入ります。

件名 場所 開始日時 終了日時 予定の本文 必須出席者 任意出席者 空欄 EntryID

更新の場合はその予定アイテムのIDと一致した場合に実施されるようにしました。

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

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

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

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

VBAは以下の通りとなります。

Sub Outlookの予定表へ登録する_重複スキップ_Excelリストから変更できる版()

    '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 olItemBefor As AppointmentItem
    Dim checkFlg As Long
    
    '重複チェックフラグ初期値設定
    checkFlg = 0
    
    
    
    'Excel用の定義
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    
    Dim lnContactCount As Long
    Dim i 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
                    
                        '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
                                 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
                    'ExcelI列の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

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

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

        Next
    
    Else
        MsgBox "処理を中断します"
        Exit Sub
    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ユーザのみで利用するようお願いします。

>>続いて、予定登録処理の高速版、終日予定の登録方法について説明します!



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

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








109 件のコメント

  • 度々すみません。
    こちらのVBAは自分のOutlook予定表に読み込むコードですが、他人のOutlook予定表にインポートすることは可能でしょうか?どこかにコードを足せばできますか?お手数ですが、お教えいただきたく、お願いいたします。

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

      お問い合わせの他人のOutlook予定表に登録できるかの件につきまして、
      対応可能となっております。

      方法については以下の記事にまとめておりますので、
      ご参考いただければと存じます。
      https://extan.jp/?p=2275

  • 早速のお返事ありがとうございました!!試してみます!!
    本当にいつも便利な内容をありがとうございます。

  • いつも大変参考にさせていただいております。ありがとうございます。予定表の公開方法ですが、「空き時間」表示にすることはできませんでしょうか?ご確認・ご返信いただけますと幸いです。
    よろしくお願いいたします。

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

      予定表の公開方法で「空き時間」表示にする件ですが、
      空き時間はOlBusyStatusの定数0で指定することができます。
      コードは以下のように指定します。
      olItem.BusyStatus = 0

      なお、OlBusyStatusの他の定数については以下の通りとなります。

      1:仮の予定
      2:予定あり
      3:外出中

  • いつも参考にさせていただいております。
    しょうもない質問かもしれないのですが、Outlookの予定表に差し込む際に色をデフォルトのブルーカラーから変更するolItm.のコードは存在しますか?色の指定方法があれば合わせてご教示いただけますと幸いです。

  • Outlookの予定表へ登録する_高速版使わせてもらっています。

    “予定表へ登録しますか?”と表示され、”いいえ”を選択すると、”処理を中断します”→”OK”しかないのでそれを押すと、”Outlook予定表の登録が完了しました!”と表示されます。
    送信したときと、しなかったときで表示を変えたいのですが、コードを追加していただけないでしょうか。
    よろしくお願いいたします。

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

      “予定表へ登録しますか?”の”いいえ”選択時に”処理を中断します”で完了させるようコードを追記させていただきました。
      具体的には、MsgBox “処理を中断します”の下にExit Subを追加し、Subプロシージャを中断し抜けるようにしています。

  • Sub Outlookの予定表へ登録する_高速版()を使用させてもらいました。
    何点か質問があるうちの一つになります。
    予定の更新や削除をした場合、エクセル情報からカレンダーへ反映させることはできますか。
    よろしくお願いします。

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

      ご質問のExcel情報の予定を変更/削除した場合のカレンダーへの反映可否につきまして、
      変更は可能としておりますが、削除は不可(機能未実装)となっておりますこと
      ご了承願います。

  • 初めて利用させていただきました。VBAは触ったことが無かったのですが非常に便利で感動しております。
    すでにすごく重宝しておりますが、更に効率よくしたい為、ご質問です。
    別シートより関数で引っ張った日時をOutlookに同期したいのですが、日によって空白になるセルがございます。そこをスルーして次の行にいくマクロをご教授いただけないでしょうか。

    マクロは下記をそのまま利用しております。
    =========
    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
    =========

    お手数おかけしますが、よろしくお願いいたします。

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

      空白時に処理をスキップさせるには以下のように
      セルの値が空白かどうか判定する処理を登録処理の前に追加すればいけると思います。
      If Cells(i, **).Value <> “” Then
        <登録処理>
      End If
      **は空白判定をしたい列番号を入れてください。例えばA列であれば1、B列は2となります。

  • いつも便利な機能をありがとうございます。日時別取り込みについて、早速のご教授を大変助かりました。お礼が遅くなり申し訳ございません。
    エクセルからの読み込みで、以下についても取り込みたいと思っています。その場合は、どのようにすればよろしいでしょうか?
    ①定期的な予定: 以下コードを削除?
    ‘定期アイテムは除外します。
    If Not olItemBefor.IsRecurring Then
    ②予定の公開方法を仮にする
     With olItemBefor部分に「.BusyStatus = Cells(i, 12)」を追加

    お手数ですが、教えていただけますとありがたく存じます。
    よろしくお願いいたします。

    ***サンプルコード↓※上記②追加済み*****
    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

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

    ‘ExcelI列へ発行された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

    • ご連絡ありがとうございます。

      ①の定期的な予定の登録につきましては、ご指定のコードを外すとエラーとなる可能性があります。
      定期的な予定は単体の予定アイテムと異なるプロパティ構成となっており、定期的な予定に単体の予定のプロパティを設定をするとミスマッチになるためです。
      ですので、定期的な予定を登録する場合は処理を別に用意する必要があります。

      登録方法の詳細はMSのサイトにありますのでご参考ください。
      https://learn.microsoft.com/ja-jp/office/vba/outlook/how-to/items-folders-and-stores/create-a-recurring-appointment-that-occurs-every-2-years
      https://learn.microsoft.com/ja-jp/office/vba/api/outlook.recurrencepattern.interval
      また、定期的な予定を登録する方法について、ゆっくりですが記事を作成しているところですので、定期的にチェックいただければと存じます。

      以下は毎週月曜日の定期的な予定を登録する場合のサンプルコードです。こちらもご参考ください。
      Set olPattern = olItem.GetRecurrencePattern
      With olPattern
      .RecurrenceType = olRecursWeekly ‘週次予定
      .Interval = 1 ‘1週間ごと
      .DayOfWeekMask = olMonday ‘月曜日に設定
      .PatternStartDate = #2/20/2023 2:00:00 PM#
      .PatternEndDate = #3/27/2023 3:00:00 PM#
      End With
      With olItem
      .Body = “予定の本文”
      .Subject = “予定のタイトル”
      .Location = “場所”
      .Save
      End With

      ②予定の公開方法を仮にする方法につきましては、ご指定の内容でよいと思います。
      仮の予定ありの場合は1かolTentativeを指定いただければと存じます。

  • ご説明ありがとうございます。
    大変参考になります。
    他の方も触れていますが、規定の予定ではなく、自分で作成したサブの予定表に予定を登録したいです。
    何かやり方があれば教えていただけると大変助かります。
    よろしくお願い致します。

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

      規定でない予定表へ予定を登録する方法につきまして、
      GetDefaultFolderメソッドでは規定のフォルダが対象となるため、対応いたしかねます。

      他の方法といたしましては、Foldersオブジェクトのみを使い、フォルダの階層分指定して操作する方法があります。
      例えば1番目に位置するユーザの直下にある”追加予定表”フォルダを対象とした場合は、
      Set olFolder = olNamespace.Folders(1).Folders(“追加予定表”)
      のように指定することが可能です。
      ユーザの位置番号や多重階層のフォルダの指定方法などは別途記事にまとめたいと思いますので、
      またでき次第ご連絡させていただきます。

  • こんにちは。大変便利な機能のご紹介をありがとうございます。
    ご質問ですが、日付と時間をセルごとに分けてインポート、エクスポートすることは難しいでしょうか?ご教授のほどお願いいたします。

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

      日付と時間をセルごとに分けてインポート、エクスポートする件につきまして、以下のようにすることにより可能です。

      ■前提
      開始日時(Startプロパティ)を対象とする
      U列:日にち
      V列:時間

      ■Excelへエクスポート
      With olItem処理内へ以下を追加します。
      arrStart = Split(.Start, ” “) ‘開始日時文字列を日と時間に分割する
      Cells(lnContactCount, 21).Value = arrStart(0) ‘日にち
      Cells(lnContactCount, 22).Value = arrStart(1) ‘時間

      ■ExcelからOutlookへインポート
      With olItem処理内のStartプロパティ設定箇所を以下に変更します。
      .Start = Format(Cells(i, 21) + Cells(i, 22), “yyyy/mm/dd hh:mm:ss”)

      ※Endプロパティも同じ要領で変更すれば分割処理可能です。

  • ありがとうございます。参考にさせていただきます。
    Outolookの予定表に取り込む際、自分のデフォルトの予定表ではなく指定の予定表にのみ取り込む際はどのようにしたらいいでしょうか?他の人のコメントの返信を参考にさせていただき、
    Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)の部分を
    Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar).Folders(“営業部カレンダー”)に変えてみて色々試したのですが、「個人用の予定表」の「予定表」に毎回追加されてしまいます。
    プロパティを確認し、プロパティ>全般タブ>場所を確認しても
    <規定となっている自分のアドレス>¥予定表に営業部のカレンダーが保存はされております。
    考えられる原因はありますでしょうか。

    • ご連絡ありがとうございます。

      追加したフォルダへ予定が登録できない件ですが、アドレス以外に、データファイルも規定になっているかご確認いただけますでしょうか。
      アカウント設定>データファイルから確認ができます。
      また、規定アドレス予定表へ新規にフォルダを作成したものをFoldersの引数へ指定し、同様に動作可能か確認をお願いします。

  • 本日初めて拝見させていただき、大変参考になったので、使用させてもらいました。ありがとうございます。

    質問なのですが、他人のカレンダーにのみ予定を反映する、もしくは共有のカレンダーにのみ予定を反映させる場合はどのようにすればよいのでしょうか。ご教授いただきたくよろしくお願いします。

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

      他人のカレンダーへ予定を登録する方法につきましては、
      以下の記事にまとめておりますので、ご参考いただきたくお願いいたします。
      https://extan.jp/?p=2275

  • タカヒロ様、はじめまして。
    ここ最近マクロの勉強を始め、こちらのサイトの内容を参考に勉強させて頂いております。

    ExcelからOutlookの予定を追加する際の重複時のスキップ、更新がどうしてもうまくいかず教えて頂きたいです。

    タカヒロ様がご紹介してるコード
    ①新規でOutlook の予定を更新
    ②重複してる予定をスキップする
    ③重複してる予定をスキップ、更新する

    上記①②③全てご紹介の通りにコードを作成し、マクロを組んでおります。②③を実施した際、2回以上更新をかけると重複スキップ、更新がうまく反映されてこず、Excelに入力された全てのスケジュールが新規追加でOutlook スケジュールに入力されてしまう現象が起きています。
    エラーコードは出ておらず、新規追加は問題なくできている事(③の場合はEntyIDの入力も問題なく自動で打ち込まれます)、1つ1つコードを確認してみましたが、スペルなども間違ってる様子はなく原因が分からず困っています。

    お手数ですが、ご教示頂けますと幸いです。よろしくお願い致します。

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

      Outlook の予定登録の重複処理がうまくいかない件につきまして、
      新規登録およびEntryID挿入は問題ないということで、更新の判定をする処理でうまくいっていない可能性があります。

      更新の判定をする箇所は以下となっておりますが、
      ExcelシートのI列(9列目)にEntryIDが存在するか、またデバッグしてCells(i, 9)の値を確認いただきたくお願いいたします。
      If olItemBefor.EntryID = Cells(i, 9) Then

  • 回答ありがとうございます。
    Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar)の部分を
    Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar).Folders(“会社の休日”)
    に変えてみて色々試したのですが、「個人用の予定表」の「予定表」に毎回追加されてしまいます。他に確認するところがあれば教えてください。すいません。

    • Foldersの指定でうまく登録されない場合は、指定フォルダが規定のフォルダにない可能性があります。

      今回対象の“会社の休日”を右クリックしプロパティ>全般タブ>場所についてご確認いただけますでしょうか。
      以下のようになっていればGetDefaultFolder(olFolderCalendar)メソッドで取得が可能です。
      <規定となっているご自身のアドレス>\予定表

  • 本日初めて拝見させていただき、大変参考になったので、使用させてもらいました。
    質問ですが、Outolookの予定表に取り込む際、指定の予定表(例えば「会社の休日」という名前の予定表)にのみ、取り込む際はどのようにしたらいいでしょうか?

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

      指定の予定表のみに絞り込む方法ですが、以下の記事に詳細をまとめておりますので、
      よろしければご参照ください。
      https://extan.jp/?p=3370

      「会社の休日」の場合は
      Set olFolder = olNamespace.GetDefaultFolder(olFolderCalendar).Folders(“会社の休日”)
      で可能かと存じます。

      ただし、規定アカウントの規定フォルダが対象となりますので、
      他人や共有アカウントのフォルダの場合は対象外となりますことご了承願います。

  • コメントを残す

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