Πώς να εισαγάγετε γενέθλια από το Excel στο ημερολόγιο του Outlook;

Εάν έχετε μια μεγάλη λίστα με πληροφορίες γενεθλίων σε ένα φύλλο εργασίας, τώρα, θέλετε να εισαγάγετε αυτά τα γενέθλια στο ημερολόγιό σας του Outlook ως συμβάντα. Πώς θα μπορούσατε να αντιμετωπίσετε αυτό το έργο με μερικές γρήγορες μεθόδους;

Εισαγάγετε γενέθλια από το Excel στο ημερολόγιο του Outlook με κώδικα VBA

Κανονικά, δεν υπάρχει άμεσος τρόπος εισαγωγής των γενεθλίων στο ημερολόγιο του Outlook. Εδώ, θα δημιουργήσω έναν κώδικα VBA για να λύσω αυτό το πρόβλημα, ακολουθήστε τα παρακάτω βήματα:

1. Ανοίξτε το φύλλο εργασίας που περιέχει τα γενέθλια που θέλετε να εισαγάγετε στο Outlook και, στη συνέχεια, κρατήστε πατημένο το ALT + F11 για να ανοίξετε το Microsoft Visual Basic για εφαρμογές παράθυρο.

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 για εφαρμογές παράθυρο, κάντε κλικ στην επιλογή Εργαλεία > αναφορές. Στο έσκασε Αναφορές - VBAProject πλαίσιο διαλόγου, επιλέξτε Βιβλιοθήκη αντικειμένων Microsoft Outlook 16.0 επιλογή από το Διαθέσιμες αναφορές πλαίσιο λίστας, δείτε το στιγμιότυπο οθόνης:

4. Στη συνέχεια κάντε κλικ στο κουμπί OK για να κλείσετε αυτό το παράθυρο διαλόγου. Τώρα, πατήστε F5 κλειδί για την εκτέλεση αυτού του κώδικα και εμφανίζεται ένα πλαίσιο προτροπής, επιλέξτε τις στήλες ονόματος και γενεθλίων, δείτε στιγμιότυπο οθόνης:

5. Και μετά, κάντε κλικ στο OK κουμπί, τα γενέθλια θα εισαχθούν στο ημερολόγιο του Outlook αμέσως, μπορείτε να εκκινήσετε το Outlook για να δείτε το αποτέλεσμα, δείτε στιγμιότυπο οθόνης: