【VBA】一瞬でExcelのスケジュールを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
                
                    '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)
                                    .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 "処理を中断します"
        Exit Sub
    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利用歴の長い方ほど効果がでると思います。

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

【追加】予定表の公開方法を指定するVBA

読者の方から予定表の公開方法を指定する質問がありましたので、追記致します。

予定登録時に予定の公開方法を合わせて指定する場合は、
BusyStatusプロパティへ以下の値を指定することで対応可能です。

名前 説明
olBusy 2 予定あり
olFree 0 予定なし
olOutOfOffice 3 外出中
olTentative 1 仮の予定あり
olWorkingElsewhere 4 リモート

Excelシートへ値を指定し、VBAへ渡す場合は、
例えばL列を「予定の公開方法」とした場合は、
L1セルにタイトル名、L2以降に上記表の値の数字か名前を入力します。

VBA側では各オブジェクトへプロパティを指定する箇所に以下を追加します。

.BusyStatus = Cells(i, 12)

サンプルコード中では以下オブジェクトの2か所になります。

With olItemBefor
With olItem

実行してみましょう。

値を「外出中」の3に指定してみましたが、予定表をみますと…

はい、「予定の公開方法」が指定通りですね。

【追加】終日の予定を登録する

読者の方からのご要望により時間指定の予定以外に終日の予定の登録方法について記載いたしましたので、
終日の予定も併せて登録されたい方はこちらをご参照ください。

【VBA】Excel からOutlookへ終日の予定を登録する方法!複数日指定も!

 

さいごに

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

【VBA】ExcelからOutlookの追加した予定表へスケジュールを登録する

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

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

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



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

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








102 件のコメント

  • いつも参考にさせていただいております。
    しょうもない質問かもしれないのですが、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(“会社の休日”)
      で可能かと存じます。

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

  • コメントを残す

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