Как автоматически отправить контактному лицу поздравительное сообщение в Outlook, если сегодня его день рождения?

Иногда возникает необходимость автоматически отправлять поздравительное сообщение контакту в Outlook, если сегодня его день рождения. Вручную проверять дни рождения всех контактов и отправлять поздравления по одному — утомительная задача. В этой статье я покажу вам простой и эффективный код VBA, который решит эту проблему быстро и без лишних усилий.

Автоматическая отправка поздравительного сообщения контакту на основе его дня рождения с помощью кода VBA в Outlook

---

Автоматическая отправка поздравительного сообщения контакту на основе его дня рождения с помощью кода VBA в Outlook

Чтобы автоматически отправлять поздравительное сообщение контакту в день его рождения, сначала вставьте код VBA, а затем настройте повторяющуюся задачу для его запуска.

Следующие шаги могут вам помочь:

1. Запустите Outlook и нажмите сочетание клавиш ALT + F11, чтобы открыть окно Microsoft Visual Basic for Applications.

2. В окне Microsoft Visual Basic for Applications дважды щелкните элемент ThisOutlookSession на панели Project1 (VbaProject.OTM), чтобы открыть модуль, а затем скопируйте и вставьте приведённый ниже код в пустой модуль.

Код 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. В окне Microsoft Visual Basic for Applications выберите Сервис > Ссылки. В появившемся диалоговом окне Ссылки — Project1 установите флажки напротив пунктов Microsoft Word Object Library и Microsoft Scripting Runtime в списке Доступные ссылки, как показано на снимке экрана:

4. Затем нажмите кнопку ОК, чтобы закрыть диалоговое окно. Теперь нужно создать задачу для запуска кода VBA. Перейдите на панель Задачи и нажмите кнопку Задача, чтобы создать задачу:

(1.) В строке Темаукажите следующее значение темы:Отправка поздравления с днём рождения;

(2.) Затем нажмите кнопку Повторениена вкладке Задача;

(3.) В диалоговом окне Повторение задачивыберите пункт Ежедневнои укажите параметр every 1 day(s)в разделе Шаблон повторения;

5. Затем нажмите кнопку ОК, чтобы закрыть диалоговое окно. Вернувшись в окно задачи, настройте напоминание для повторяющейся задачи, как показано на следующем снимке экрана:

6. С этого момента при появлении напоминания макрос будет запускаться немедленно. Появится диалоговое окно с предложением вставить текст поздравления с днём рождения, как показано на следующем снимке экрана:

7. Затем нажмите кнопку ОК, и поздравительное письмо будет автоматически отправлено контакту, у которого сегодня день рождения.