如何在 Outlook 中，於聯絡人生日當天自動傳送問候訊息給對方？

有時，您可能希望在 Outlook 中，當聯絡人的生日恰逢今天時，自動傳送問候訊息給對方。若逐一檢查每位聯絡人的生日並手動寄送祝福郵件，將極為繁瑣耗時。本文將為您介紹一段 VBA 程式碼，助您快速輕鬆解決此問題。

在 Outlook 中使用 VBA 程式碼，根據聯絡人生日自動傳送問候訊息

---

在 Outlook 中使用 VBA 程式碼，根據聯絡人生日自動傳送問候訊息

若要在聯絡人的生日為今天時自動傳送問候訊息，請先插入一段 VBA 程式碼，再設定一個週期性工作來觸發該程式碼。

以下步驟可協助您完成設定：

1. 啟動 Outlook，然後按住 ALT + F11 鍵，即可開啟 Microsoft Visual Basic for Applications 視窗。

2. 在 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 

3. 接著在 Tools>References 中（位於 ）Microsoft Visual Basic for Applications 視窗），於彈出的 References-Project 1 對話方塊中，從 Microsoft Word Object Library 與 Microsoft Scripting Runtime 選項中勾選 Available References 清單方塊中的項目，如下圖所示：

4. 接著按一下 OK 關閉對話方塊。現在，您需要建立一項工作來觸發 VBA 程式碼。請前往 Task 窗格，按一下任務以建立工作：

(1.) 在 Subject 欄位中，請輸入主旨為 Send Birthday Greeting Mail；

(2.) 接著按一下 Recurrence（位於 ）Task 頁籤下方）；

(3.) 在 Task Recurrence 對話方塊中，選取 Daily，並在 every 1 day(s) 區段中指定定期模式選項；

5. 接著按一下 OK 關閉對話方塊。返回工作視窗後，請依照下圖所示設定週期性工作的提醒：

6. 從現在起，每當提醒出現時，巨集將立即被觸發，並彈出對話方塊，提示您插入生日問候內容，如下圖所示：

7. 接著點擊 OK 按鈕，系統將自動傳送問候郵件給生日為今天的聯絡人。