Как импортировать дни рождения из Excel в календарь Outlook?

Если у вас на листе есть длинный список дней рождения и вы хотите быстро импортировать их в календарь Outlook в качестве событий, как это можно сделать наиболее эффективно?

---

Импорт дней рождения из Excel в календарь Outlook с помощью кода VBA

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

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

2. Нажмите Вставка > Модуль и вставьте следующий код в окно модуля.

Код VBA: Импорт дней рождения в календарь Outlook

Sub ImportBirthdaysToCalendar()
'Updateby ExtendOffice
Dim xWs As Excel.Worksheet
Dim xRng As Range
Dim xOlApp As Outlook.Application
Dim xCalendarFld As Outlook.Folder
Dim xAppointmentItem As Outlook.AppointmentItem
Dim xRecurrencePattern As Outlook.RecurrencePattern
Dim xRow As Integer
On Error Resume Next
Set xWs = ThisWorkbook.ActiveSheet
Set xRng = Application.InputBox("Please select the data range (only two columns):", "Kutools for Excel", , , , , , 8)
If xRng Is Nothing Then Exit Sub
If xRng.Columns.Count <> 2 Then
  MsgBox "You can only select two columns", vbOKOnly + vbCritical, "Kutools for Excel"
  Exit Sub
End If
Set xOlApp = CreateObject("Outlook.Application")
Set xCalendarFld = xOlApp.Session.GetDefaultFolder(olFolderCalendar)
For xRow = 1 To xRng.Rows.Count
  Set xAppointmentItem = xCalendarFld.Items.Add("IPM.Appointment")
  With xAppointmentItem
    .Subject = xRng.Cells(xRow, 1) & Chr(39) & "s Birthday"
    .AllDayEvent = True
    .Start = xRng.Cells(xRow, 2)
    Set xRecurrencePattern = .GetRecurrencePattern
    xRecurrencePattern.RecurrenceType = olRecursYearly
    .Save
  End With
Next
Set xWs = Nothing
Set xCalendarFld = Nothing
Set xOlApp = Nothing
End Sub

3. Не закрывая окно Microsoft Visual Basic for Applications, нажмите Сервис > Ссылки. В появившемся диалоговом окне Ссылки – VBAProject установите флажок напротив пункта Библиотека объектов Microsoft Outlook 16,0 в списке Доступные ссылки, см. снимок экрана:

4. Затем нажмите кнопку ОК, чтобы закрыть это диалоговое окно. После этого нажмите клавишу F5, чтобы запустить код. Появится диалоговое окно запроса: «Пожалуйста, выберите столбцы с именами и днями рождения» (см. снимок экрана):

5. После этого нажмите кнопку ОК, и дни рождения будут немедленно импортированы в календарь Outlook. Откройте Outlook, чтобы увидеть результат — см. снимок экрана: