【VBA】Outlookで複数の会議を一括で送信する方法

本記事ではOutlookの複数の日時に会議を設定する場合、VBAを使用して複数の会議を設定する方法をご紹介いたします。

会議の件名や本文、参加者の連絡先などはエクセル上で管理できるため、VBAの知識は一切不要でどなたでも簡単にご使用いただけます。

コンテンツ

結論
Outlookで複数の会議を一括で送信するステップの解説
マクロの実行
おわりに

結論

下記のステップを経ることで実行環境作成及び自動化の実行が可能です。

Outlookで複数の会議を一括で送信する

ステップ
任意のエクセルマクロファイル(ファイル名.xlsm)のファイルを作成しVBAコードをコピペ
ステップ
同じフォルダ内に送付したい本文をWordまたはテキストファイルとして作成

以下に各ステップの詳細を解説します。

Outlookで複数の会議を一括で送信するステップの解説

エクセルマクロファイル作成とVBAコードのコピペ

まず、好きな名前でエクセルマクロファイル(Outlook 会議招待一斉送信用マクロ.xlsmなど)として空のエクセルファイルを作成します。

次に、シートの左上(A1セル)から下記のテーブルのとおりに列名を入力します。(コピペでOK)

件名

場所

開始時刻

会議時間(分)

To宛先

Cc宛先

Teamsリンク

Zoomリンク

返信の依頼オフ

自動送信

その後、各列に必要な情報を必要な行数分入力してください。不要な箇所は空欄のままとしてください。なお、各列の説明は下記のとおりです。

件名：Outlook会議で表示される会議の件名です
場所：会議の開催場所を入力してください。オンライン会議用のリンクについては不要です
開始時刻：会議の開始時刻をエクセルが日付と認識できる形で入力してください(2023/8/31 14:00、など)
会議時間：分単位で会議時間を入力してください
To宛先：To及び必須参加者のメールアドレスを入力してください。複数人いる場合は“;”とセミコロンで区切って同じセルに入力してください
Cc宛先：Cc及び任意参加者のメールアドレスを入力してください。複数人いる場合は“;”とセミコロンで区切って同じセルに入力してください
Teamsリンク：オンライン会議用にTeamsリンクを挿入する場合は、TRUEと入力してください(OutlookのAd-inが有効化されている必要があります)
Zoomリンク：オンライン会議用にZoomリンクを挿入する場合は、TRUEと入力してください(OutlookのAd-inが有効化されている必要があります)
返信の依頼オフ：Outlookの会議アイテム用に返信を要求しない場合(リマインダーとしての設定など)の場合は、TRUEと入力してください
自動送信：目視での確認をせずに自動で送信したい場合は、TRUEと入力してください

エクセル上では下記のようになっていればOKです。

イメージ解説

次に、VBAコードのコピペを行います。下記のコードをコピペして、エクセルVBAの新しいモジュールとして保存しましょう。

Sub MultipleMeeting_eMail()
'Written by consulting-campus.site
'
'
'
Dim OutApp As Object
Dim OutMail As Object
Dim rw As Long
Dim LR As Long
Dim wd As Object
Dim doc As Object

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

LR = Cells(Rows.Count, "A").End(xlUp).Row
Set OutApp = CreateObject("Outlook.Application")

Set wd = CreateObject("Word.Application")
Set doc = wd.Documents.Open(ThisWorkbook.Path & "\" & Range("Sheet2!A1").Value)
doc.Content.Copy

For rw = 2 To LR
    Set OutMail = OutApp.CreateItem(olAppointmentItem)
    With OutMail
        .MeetingStatus = olMeeting
        .RequiredAttendees = Cells(rw, "E").Value
        .OptionalAttendees = Cells(rw, "F").Value
        '.RequiredAttendees.Type = olRequired
        .Start = Cells(rw, "C").Value
        .Subject = Cells(rw, "A").Value
        .Duration = Cells(rw, "D").Value
        .BusyStatus = olBusy
        .Location = Cells(rw, "B").Value
        If Cells(rw, "I").Value = True Then
            .ResponseRequested = False
        End If
        
        Set editor = .GetInspector.WordEditor
        editor.Content.Paste
        .display
        Application.Wait Now() + TimeValue("00:00:05")
        If Cells(rw, "G").Value = True Then
            Call SendKeys("%", True)
            Call SendKeys("H", True)
            Call SendKeys("TM", True)
        End If
        If Cells(rw, "H").Value = True Then
            Call SendKeys("%", True)
            Call SendKeys("H", True)
            Call SendKeys("Y3", True)
        End If        
        If Cells(rw, "J").Value = True Then
            .Send
        End If
    End With
    Debug.Print ("Sent item: " & Cells(rw, "C").Value)
Next rw
Set OutMail = Nothing
Set OutApp = Nothing
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
doc.Close
Set doc = Nothing
Set wd = Nothing
MsgBox ("Done")
End Sub