如何在Outlook中自动向今天生日的联系人发送祝福消息？

Author: Xiaoyang Last Modified: 2025-07-31

有时，您可能希望在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 对象库 和 Microsoft 脚本运行时 选项，见截图：