Outlook で連絡先の誕生日が今日の場合、自動的に挨拶メッセージを送信するにはどうすればよいですか？

場合によっては、Outlook で連絡先の誕生日が今日になったときに、自動的に挨拶メッセージを送信したいと思うかもしれません。個々の連絡先の誕生日をいちいち確認して、手動で挨拶メールを送るのは非常に面倒です。本記事では、この作業を素早く簡単に解決する VBA コードをご紹介します。

Outlook で VBA コードを使用して、連絡先の誕生日に基づき自動的に挨拶メッセージを送信する

---

Outlook で VBA コードを使用して、連絡先の誕生日に基づき自動的に挨拶メッセージを送信する

連絡先の誕生日が今日の場合に自動的に挨拶メッセージを送信するには、まず VBA コードを挿入し、その後、そのコードを実行するための定期タスクを設定する必要があります。

以下の手順がお役に立ちます。

1．Outlook を起動し、ALT + F11キーを押して、Microsoft Visual Basic for Applicationsウィンドウを開きます。

2．Microsoft Visual Basic for Applicationsウィンドウで、ThisOutlookSessionをProject1 (VbaProject.OTM)ペインからダブルクリックしてモジュールを開き、次のコードを空のモジュールにコピー＆ペーストしてください。

VBA コード：誕生日に基づいて連絡先に自動で挨拶メッセージを送信する

Private Sub Application_Reminder(ByVal Item As Object)
Dim xTempMail As MailItem
Dim xFilePath As String
Dim xItems As Outlook.Items
Dim xItem As Object
Dim xContactItem As Outlook.ContactItem
Dim xTodayDate As String
Dim xBirthdayDate As String
Dim xGreetingMail As Outlook.MailItem
Dim xWordDoc As Word.Document
Dim xGreetings As String
Dim xBool As Boolean
xFilePath = CreateObject("shell.Application").NameSpace(5).self.Path & "\UserTemplates"
Set xFSO = CreateObject("Scripting.FileSystemObject")
If xFSO.FolderExists(xFilePath) = False Then
    MkDir xFilePath
End If
If IsFileExists(xFilePath & "\Birthday Greeting Mail.oft") = False Then
    Set xTempMail = Outlook.CreateItem(olMailItem)
    xTempMail.SaveAs xFilePath & "\Birthday Greeting Mail.oft", olTemplate
    xTempMail.Close olDiscard
End If
If (TypeOf Item Is TaskItem) And (Item.Subject = "Send Birthday Greeting Mail") Then
xGreetings = "Happy Birthday!"
           xGreetings = InputBox("Input birthday greetings", "Kutools for Outlook", xGreetings)
   xTodayDate = Month(Date) & "-" & Day(Date)
   Set xItems = Outlook.Application.Session.GetDefaultFolder(olFolderContacts).Items
   For Each xItem In xItems
       If Not (TypeOf xItem Is ContactItem) Then Exit Sub
       Set xContactItem = xItem
       xBirthdayDate = Month(xContactItem.Birthday) & "-" & Day(xContactItem.Birthday)
       If xBirthdayDate = xTodayDate Then
           Set xGreetingMail = Outlook.Application.CreateItemFromTemplate(xFilePath & "\Birthday Greeting Mail.oft")
           Set xWordDoc = xGreetingMail.GetInspector.WordEditor
           
           xWordDoc.Range.InsertBefore "Dear " & xContactItem.LastName & Chr(10) & xGreetings & Chr(10) & Chr(10)
           With xGreetingMail
                .Recipients.Add (xContactItem.Email1Address)
                .Subject = "Happy Birthday!"
                .Display
                .Close (olSave)
                .Send
          End With
       End If
   Next
End If
End Sub
Function IsFileExists(ByVal FileName As String) As Boolean
Dim xFileSystem As Object
Set xFileSystem = CreateObject("Scripting.FileSystemObject")
If xFileSystem.FileExists(FileName) = True Then
    IsFileExists = True
Else
    IsFileExists = False
End If
End Function 

3．次に、ツール>参照設定をMicrosoft Visual Basic for Applicationsウィンドウでクリックします。参照設定 - Project1ダイアログボックスが表示されたら、利用可能な参照設定リストボックスからMicrosoft Word Object LibraryとMicrosoft Scripting Runtimeの各オプションにチェックを入れます（下記スクリーンショット参照）。

4．次に、OKをクリックしてダイアログを閉じ、VBA コードをトリガーするタスクを作成します。タスクペインに移動し、タスクをクリックして新しいタスクを作成してください。

(1．)件名欄に「誕生日のお祝いメールを送信」と入力します。

(2．)次に、タスクタブで繰り返しをクリックします。

(3．)タスクの繰り返しダイアログボックスで、毎日を選択し、1 日ごとのオプションを繰り返しパターンセクションから指定してください。

5．次に、OKをクリックしてダイアログボックスを閉じ、タスクウィンドウに戻ります。以下のスクリーンショットのように、繰り返しタスクにリマインダーを設定してください。

6．これ以降、リマインダー通知が届くとすぐにマクロがトリガーされます。以下のスクリーンショットのように、「誕生日のお祝いメッセージを挿入しますか？」と促すダイアログボックスが表示されます。

7．次にOKボタンをクリックすると、今日が誕生日の連絡先に自動で挨拶メールが送信されます。