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

有时，您可能希望在 Outlook 中自动向生日为当天的联系人发送祝福信息。如果需要逐一查找每位联系人的生日并手动发送祝福邮件，无疑会非常繁琐。本文将为您介绍一段 VBA 代码，助您轻松高效地解决这一难题。

在 Outlook 中通过 VBA 代码根据联系人生日自动发送祝福信息

---

在 Outlook 中通过 VBA 代码根据联系人生日自动发送祝福信息

若想在联系人生日当天自动发送祝福信息，您需要先插入 VBA 代码，并创建一个重复任务以触发该代码。

您可以按照以下步骤进行操作：

11. 启动 Outlook，按住 ALT + F11 键即可打开 Microsoft Visual Basic for Applications 窗口。

22. 在 Microsoft Visual Basic for Applications 窗口中，双击 Project 1(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 

33. 然后点击工具> 引用，在 Microsoft Visual Basic for Applications 窗口，弹出 引用-Project 1 对话框时，勾选 Microsoft Word 对象库和 Microsoft Scripting Runtime 选项，位于可用引用列表框中，如下图所示：

44. 然后点击确定关闭该对话框。现在，您需要新建一个任务以触发 VBA 代码。请前往任务窗格，点击新建任务即可创建任务：

（1）在主题行，您需要将主题设置为 Send Birthday Greeting Mail；

（2）然后点击周期，位于任务选项卡下；

（3）在任务周期对话框中，选择每日，并在 每 1 天 选项中指定定期模式区域；

55. 然后点击确定，关闭对话框后，返回任务窗口，请如截图所示为重复任务设置提醒：

6 从现在开始，每当提醒触发时，宏代码将立即运行，并弹出对话框提醒您插入生日祝福，如下图所示：

7 接着点击确定按钮，系统将自动为今天过生日的联系人发送祝福邮件。