Как автоматически отправить поздравительное сообщение контакту, если у него сегодня день рождения в Outlook?
Иногда вам может потребоваться автоматически отправлять поздравительное сообщение контакту, когда у него сегодня день рождения в Outlook. Это может быть утомительной задачей, если проверять дни рождения контактов по одному и вручную отправлять поздравительные письма. В этой статье я представлю код VBA для быстрого и легкого решения этой проблемы.
Автоматическая отправка поздравительного сообщения контакту на основе его дня рождения с использованием кода 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. Затем нажмите Tools > References в окне Microsoft Visual Basic for Applications, в открывшемся диалоговом окне References-Project1 установите флажки Microsoft Word Object Library и Microsoft Scripting Runtime в списке Available References, как показано на скриншоте:
4. Затем нажмите OK, чтобы закрыть диалоговое окно. Теперь вы должны создать задачу для запуска кода VBA. Перейдите в панель Task, нажмите New Task, чтобы создать задачу:
(1.) В строке Subject введите Тема как Send Birthday Greeting Mail;
(2.) Затем нажмите Recurrence под вкладкой Task;
(3.) В диалоговом окне Task Recurrence выберите Ежедневно и укажите каждые 1 день в разделе Шаблон повторения;
5. Затем нажмите OK, чтобы закрыть диалоговое окно, вернитесь в окно задачи, пожалуйста, установите напоминание для повторяющейся задачи, как показано на следующем скриншоте:
6. С этого момента, когда сработает напоминание, макрос будет немедленно запущен. Появится диалоговое окно, которое напомнит вам вставить поздравления с днем рождения, как показано на следующем скриншоте:
7. Затем нажмите кнопку OK, и поздравительное письмо будет автоматически отправлено контакту, у которого сегодня день рождения.
Лучшие инструменты для повышения продуктивности в Office
Срочные новости: Выпущена бесплатная версия Kutools для Outlook!
Оцените совершенно новый Kutools для Outlook с более чем100 потрясающими функциями! Нажмите, чтобы скачать сейчас!
📧 Автоматизация Email: Автоответчик (доступно для POP и IMAP) / Запланировать отправку Email / Авто Копия/Скрытая копия по правилу при отправке письма / Автоматическое перенаправление (Расширенное правило) / Автоматически добавить приветствие / Автоматическое разделение Email с несколькими получателями на отдельные сообщения ...
📨 Управление Email: Отозвать письмо / Блокировать мошеннические Email по теме и другим признакам / Удалить дубликаты писем / Расширенный Поиск / Организовать папки ...
📁 Вложения Pro: Пакетное сохранение / Пакетное открепление / Пакетное сжатие / Автосохранение / Автоматическое отсоединение / Автоматическое сжатие ...
🌟 Магия интерфейса: 😊Больше красивых и современных Эмодзи / Напоминания о важных письмах / Сворачивание Outlook вместо закрытия ...
👍 Мгновенные действия в один клик: Ответить всем с вложениями / Антифишинг Email / 🕘Показать часовой пояс отправителя ...
👩🏼🤝👩🏻 Контакты и Календарь: Пакетное добавление контактов из выбранных Email / Разделить группу контактов на отдельные группы / Удалить напоминание о дне рождения ...
Используйте Kutools на вашем любимом языке – поддерживается английский, испанский, немецкий, французский, китайский и более40 других языков!
