はじめに

会議や締切の予定をExcelの一覧表で管理していて、「これをそのままOutlookの予定表に登録できたら楽なのに」と感じたことはないでしょうか。

この記事では、ExcelVBAからOutlookを操作し、シート上の予定一覧（日時・件名・場所）を元にアポイントメント（予定）を自動登録する方法を解説します。CreateItemメソッドで予定を作成し、リマインダーの設定や登録済み予定の重複防止まで、実務でそのまま使えるコードを紹介します。

この記事で学べること

• ExcelVBAからOutlookを操作する基本（CreateObjectによる遅延バインディング）
• CreateItemでアポイントメント（AppointmentItem）を作成する方法
• リマインダー・件名・開始終了時刻・場所の設定方法
• 表形式のデータから予定を一括登録するマクロ

事前準備：シートの構成

以下のような予定一覧をExcelシート「予定表」に用意します。1行目は見出し行です。

参照設定（Microsoft Outlook XX.0 Object Library）を使う方法もありますが、この記事では環境依存を避けるためCreateObjectによる遅延バインディングを使います。

Outlookの予定表に予定を一括登録するマクロ

Option Explicit

Sub RegisterAppointmentsFromSheet()

    Const OL_APPOINTMENT_ITEM As Long = 1   ' olAppointmentItem
    Const OL_REMINDER_MINUTES As Long = 15  ' 開始15分前にリマインド

    Dim outlookApp As Object
    Dim appt As Object
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim subjectText As String
    Dim startTime As Date
    Dim endTime As Date
    Dim location As String

    Set ws = ThisWorkbook.Worksheets("予定表")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    If lastRow < 2 Then
        MsgBox "登録する予定データがありません。", vbExclamation
        Exit Sub
    End If

    ' Outlookが起動していなければ新規作成、起動済みなら既存を取得
    On Error Resume Next
    Set outlookApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If outlookApp Is Nothing Then
        Set outlookApp = CreateObject("Outlook.Application")
    End If

    Dim registeredCount As Long
    registeredCount = 0

    For i = 2 To lastRow
        subjectText = ws.Cells(i, "A").Value
        startTime = ws.Cells(i, "B").Value
        endTime = ws.Cells(i, "C").Value
        location = ws.Cells(i, "D").Value

        If subjectText = "" Or startTime = 0 Then
            ' 件名または開始日時が空の行はスキップ
            GoTo ContinueLoop
        End If

        Set appt = outlookApp.CreateItem(OL_APPOINTMENT_ITEM)
        With appt
            .Subject = subjectText
            .Start = startTime
            .End = endTime
            .Location = location
            .ReminderSet = True
            .ReminderMinutesBeforeStart = OL_REMINDER_MINUTES
            .BusyStatus = 2 ' olBusy
            .Save
        End With

        registeredCount = registeredCount + 1
        Set appt = Nothing

ContinueLoop:
    Next i

    MsgBox registeredCount & "件の予定をOutlookに登録しました。", vbInformation

End Sub

• GetObject(, "Outlook.Application")で起動中のOutlookを取得し、なければCreateObjectで新規起動しています。両方に対応させることで、Outlookが開いていてもいなくてもエラーになりません
• BusyStatus = 2は予定を「予定あり」として表示する設定です（0:空き時間、1:仮の予定、2:予定あり、3:外出中）
• 件名または開始日時が空の行はGoTo ContinueLoopでスキップし、空行があっても止まらないようにしています

重複登録を防ぐ工夫

このマクロを繰り返し実行すると、同じ予定が何度も登録されてしまいます。E列に「登録済みフラグ」を追加し、登録後にマークする方法がシンプルで確実です。

' Withブロックの直後（.Save の後）に追加する
ws.Cells(i, "E").Value = "登録済"

あわせてループの先頭に、以下のチェックを加えると二重登録を防げます。

If ws.Cells(i, "E").Value = "登録済" Then
    GoTo ContinueLoop
End If

予定を削除・更新したい場合

一度登録した予定を更新したい場合は、件名や開始日時などのユニークなキーで既存の予定を検索してから上書きする必要があります。Outlook.Items.FindやRestrictメソッドで対象の予定表フォルダを検索できますが、件数が多いと処理が重くなりやすいため、実務では前述の「登録済みフラグ」方式で新規登録のみ行い、変更がある場合はOutlook側で手動修正するという運用がシンプルでおすすめです。

まとめ

ExcelVBAとOutlookを連携させることで、シートにまとめた予定を一括でOutlookの予定表に登録できます。CreateItemでアポイントメントを作成し、リマインダーや場所を設定するだけなので、会議の多い職場や締切管理が煩雑になりがちな業務で特に効果を発揮します。重複登録防止のフラグ管理もあわせて導入し、安全に運用してみてください。