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

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

例えば休暇や外出で終日不在の場合などの都合で予定へ登録する時でしょうか。

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

・複数の終日の予定を一度に登録したいが方法がわからない
・Excelでまとめた予定情報をVBAで予定登録したいが方法がわからない

ではないでしょうか?

実は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
    
    '重複チェックフラグ初期値設定
    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, 7)
                                    .OptionalAttendees = Cells(i, 8)
                                    '終日の予定であるか指定します。
                                    .AllDayEvent = Cells(i, 11)
                                    .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, 7)
                    .OptionalAttendees = Cells(i, 8)
                    '終日の予定であるか指定します。
                    .AllDayEvent = Cells(i, 11)
                    .Save
               End With
    
               'エクセルI列へ発行されたEntryIDを書き込み
               Cells(i, 9) = olItem.EntryID
               'エクセルF列へ予約者を書き込み
               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 "Outlook予定表の登録が完了しました!", vbInformation
    
End Sub

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

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

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

こちらで完了です。


予定出席依頼のデータを準備する

予定出席依頼のデータを準備しましょう。

1日だけ終日の予定を指定する

VBAを実装したエクセルのシートへ
以下の項目に沿って記入をしていきます。

件名 場所 開始日時 終了日時 予定の本文 予約者 必須出席者 任意出席者 EntryID 定期的な予定 終日の予定
件名を入力 場所を入力 開始日時を”yyyy/mm/dd hh:mm:ss”形式で入力 終了日時を”yyyy/mm/dd hh:mm:ss”形式で入力
※終日指定の場合は開始日に1日プラスしてください。
予定の本文を入力 予約者が登録後入ります。空でOKです。 必須出席者のアドレスを入力 任意出席者のアドレスを入力 予定識別子のEntryIDが登録後入ります。FALSEと入力してください。 定期的な予定のフラグが入ります。空でOKです。 終日の予定のフラグが入ります。終日予定はTRUE、時間指定はFALSEとしてください。
終日の予定(1日) 2021/6/18 0:00 2021/6/19 0:00 本文 FALSE TRUE

タカヒロ
タカヒロ
開始、終了ともに同日、同時間の指定の場合は終日の予定とはなりませんので、
開始日時と終了日時は24時間あけるようお願いします。



3日間終日の予定を指定する

複数日の終日の予定を入力します。

件名 場所 開始日時 終了日時 予定の本文 予約者 必須出席者 任意出席者 EntryID 定期的な予定 終日の予定
終日の予定(3日) 2021/6/15 0:00 2021/6/18 0:00 本文 FALSE TRUE

タカヒロ
タカヒロ
終日の予定を指定する際、開始日時と終了日時の時間指定は入れないか0時を指定してください。
なお時間をを入力したとしても登録時に0時へ変換されますのでご注意ください。



VBAを実行し、終日の予定を登録する

1日だけ終日の予定を指定する

①1日だけ終日の予定を指定したExcelシートを開きます。

②「開発」タブの「マクロ」をクリックします。

③「Outlookの予定表へ終日の予定を登録する」を選択し、「実行」をクリックします。

④メッセージ「Outlook予定表の登録が完了しました!」が表示されば完成です!

終日の予定が登録されましたね。

3日間終日の予定を指定する

①3日間の終日の予定を指定したExcelシートを開きます。

②「開発」タブの「マクロ」をクリックします。

③「Outlookの予定表へ終日の予定を登録する」を選択し、「実行」をクリックします。

④メッセージ「Outlook予定表の登録が完了しました!」が表示されば完成です!

3日間分の終日の予定が登録されましたね。

3日間の終日の予定を1日へ変更する

これまで新規登録の操作を行ってきましたので、次は登録した終日の予定の期間を変更したいと思います。

サンプルでは3日間の期間指定を1日へ短縮し、値を変更しています。

また、変更にあたり、EntryIDが入力されているか確認をしてください。

①予定を変更したExcelシートを開きます。

②「Outlookの予定表へ終日の予定を登録する」を選択し、「実行」をクリックします。

③メッセージ「Outlook予定表の登録が完了しました!」が表示されば完成です!

終日の予定の期間が変更されましたね!

 



今回のVBAについて説明

今回のVBAは「【VBA】一瞬でExcelワークシートからOutlookの予定表へスケジュールを登録する」で公開いしている「Outlookの予定表へ登録する_高速版」をもとに機能追加したものになります。

詳細は「【VBA】一瞬でExcelワークシートからOutlookの予定表へスケジュールを登録する」をご参照ください。

今回VBAを追加した箇所は、

終日の予定であるかを指定するAllDayEventプロパティ

となります。

AllDayEventプロパティはブール値となり、Trueであれば時間ではなく終日のイベント、Falseであらば時間帯指定の予定を指定することができます。

サンプルコードでは以下のように、Excelシートの11列目(K)列の値を参照し、AllDayEventプロパティへ渡しています。

.AllDayEvent = Cells(i, 11)

追加した箇所は二か所で、

新規作成の処理と更新の処理の箇所となります。

EntryIDが空である場合のみ新規登録をします。

If checkFlg <> 1 And Cells(i, 9) = “” Then

エクセルI列のEntryIDと登録されているEntryIDが一致していたら該当予定表を更新します。

If olItemBefor.EntryID = Cells(i, 9) Then

最後にSaveメソッドで予定を登録します。

.Save



さいごに

いかがでしょうか。

今回は
Excelにまとめた予定情報からOutlookの終日の予定を登録する方法について
まとめました。

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



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

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



4 件のコメント

  • ありがとうございます。
    参考にさせていただきました。

    エクセル上に”予約者”の列を追加しているので
    必須出席者(RequiredAttendees)と任意出席者(OptionalAttendees)を登録するセルの指定数字がずれているかと。

    • ご指摘ありがとうございます。

      確かに必須出席者と任意出席者のセルとVBAの指定セルがずれておりましたので、
      公開コードを修正させて頂きました。

  • すみません。この記事と関係ない内容の質問をします。
    VBAでリダイレクト処理をしたいのですがご教授願えますか?
    仕分けルールで転送設定をすると、送ってきた人のアドレスが転送先に表示されてしまうので、そこを自分に変えるだけのスクリプトで構いません。

    環境は Win10 / Outlook2016 です。Exchange Server は使わず、スクリプト処理のみの方法を模索しています。

    大変恐れ入りますが、よろしくお願い致します。

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

      仕分けルール+スクリプト(差出人を元の差出人ではなく転送者に変更)実行の組み合わせでリダイレクトを実現したいということでよろしいでしょうか。

      仕分けルールからスクリプトを実行するメニューはOutlook2010以降、セキュリティ対策の観点で非表示となっていますので、まずはスクリプト実行メニューを表示させるレジストリ設定の必要があります。

      キー : HKEY_CURRENT_USER\Software\Microsoft\Office\xx.0\Outlook\Security
      名前: EnableUnsafeClientMailRules
      種類: REG_DWORD
      値: 1 (有効)
      ※レジストリ キーのパス中にある xx の選択
       Outlook 2016 の場合 : 16

      【ご参考】
      https://qiita.com/Q11Q/items/a83b2d1434e93289058f

      すでに対応されているようでしたらご放念ください。

      次に転送メールの差出人をご自身に変更する処理は、Forwardメソッドを利用します。

      通常リダイレクト処理は元メールをコピーして送信しますが、その場合、差出人は元の差出人に固定されます。(VBA上でSenderEmailAddressプロパティに格納されていますが、読み取り専用となり、変更はできません。)

      そこで元メールをForwardメソッドで転送メールとして処理します。
      転送メールですので、差出人は転送した人のアドレスに置き換わる、つまりご自身のアドレスになるというわけです。

      VBAは以下となります。

      Sub 対象メールをコピーして送信する_カスタムルール(Item As Outlook.MailItem)

      Dim objFwItem As Outlook.MailItem

      ‘ルールの条件に該当したメールアイテムを転送としてセットします。
      Set objFwItem = Item.Forward

      ‘転送先を指定します。
      ‘転送先アドレスを指定してください。
      objFwItem.To = “***@****.***”

      ‘件名を指定します。
      objFwItem.Subject = Item.Subject & “<メール転送のテストです>”

      ‘メール本文を指定します。
      objFwItem.Body = “↓↓↓以下転送元の内容となります。↓↓↓” & vbCrLf _
      & Item.Body

      ‘送信します。
      objFwItem.Recipients.ResolveAll
      objFwItem.Send

      End Sub

      ルールの条件にスクリプトで実行を選択し、上記VBAを指定してください。

      こちらの環境(Win10 / Outlook2016)で実行まで確認できました。
      ご不明な点等ありましたらご連絡ください。

  • コメントを残す

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