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

Author: Xiaoyang Last Modified: 2025-05-23

時々、Outlookで連絡先の誕生日が今日の場合、挨拶メッセージを自動的に送信したいと思うかもしれません。連絡先の誕生日を一つずつ確認し、挨拶メールを手動で送信するのは面倒な作業です。この記事では、その問題を迅速かつ簡単に解決するためのVBAコードを紹介します。

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

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

誕生日が今日の連絡先に挨拶メッセージを自動送信するには、まずVBAコードを挿入し、その後、コードをトリガーするための繰り返しタスクを作成する必要があります。

次の手順が役立つかもしれません：

1. Outlookを起動し、ALT + F11キーを押したままにすると、Microsoft Visual Basic for Applicationsウィンドウが開きます。

2. Microsoft Visual Basic for Applicationsウィンドウで、Project1(VbaProject.OTM)ペインからThisOutlookSessionをダブルクリックしてモジュールを開き、次のコードを空白のモジュールにコピーして貼り付けます。

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

the screenshot of step about using vba to send a greeting message to a contact automatically if his birthday is today in Outlook 1

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