如何在Outlook中自動向生日為今天的聯絡人發送祝福訊息？

Author: Xiaoyang Last Modified: 2025-08-06

有時候，您可能希望在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窗口中的「工具」 > 「引用」，在彈出的References-Project1對話框中，從可用引用列表框中勾選Microsoft Word Object Library和Microsoft Scripting Runtime選項，參見截圖：