Bỏ qua nội dung chính

Làm cách nào để nhập sinh nhật từ Excel sang lịch Outlook?

Nếu bạn có một danh sách dài thông tin sinh nhật trong một trang tính, bây giờ, bạn muốn nhập những sinh nhật này vào lịch Outlook của mình dưới dạng sự kiện. Làm thế nào bạn có thể đối phó với nhiệm vụ này với một số phương pháp nhanh chóng?


Nhập sinh nhật từ Excel sang lịch Outlook với mã VBA

Thông thường, không có cách nào trực tiếp để nhập sinh nhật vào lịch Outlook, ở đây, tôi sẽ tạo mã VBA để giải quyết vấn đề này, vui lòng thực hiện theo các bước sau:

1. Mở trang tính có chứa ngày sinh mà bạn muốn nhập vào Outlook, sau đó nhấn giữ ALT + F11 phím để mở Microsoft Visual Basic cho các ứng dụng cửa sổ.

2. Nhấp chuột Chèn > Mô-đunvà dán mã sau vào Cửa sổ mô-đun.

Mã VBA: Nhập sinh nhật vào lịch 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. Vẫn trong Microsoft Visual Basic cho các ứng dụng cửa sổ, nhấp CÔNG CỤ > dự án. Trong cửa sổ bật ra Tài liệu tham khảo - VBAProject hộp thoại, kiểm tra Thư viện đối tượng Microsoft Outlook 16.0 tùy chọn hình thành Tài liệu tham khảo có sẵn hộp danh sách, xem ảnh chụp màn hình:

4. Sau đó nhấn vào OK để đóng hộp thoại này. Bây giờ bấm F5 để chạy mã này và một hộp nhắc xuất hiện, vui lòng chọn cột tên và ngày sinh, xem ảnh chụp màn hình:

5. Và sau đó, nhấp vào OK , sinh nhật sẽ được nhập vào lịch Outlook ngay lập tức, bạn có thể khởi chạy Outlook của mình để xem kết quả, xem ảnh chụp màn hình:


Công cụ năng suất văn phòng tốt nhất

Kutools cho Outlook - Hơn 100 tính năng mạnh mẽ để tăng cường Outlook của bạn

🤖 Trợ lý thư AI: Email chuyên nghiệp tức thì với phép thuật AI--một cú nhấp chuột để có câu trả lời xuất sắc, giọng điệu hoàn hảo, khả năng thông thạo đa ngôn ngữ. Chuyển đổi email một cách dễ dàng! ...

📧 Tự động hoá email: Vắng Mặt (Có sẵn cho POP và IMAP)  /  Lên lịch gửi email  /  Tự động CC/BCC theo quy định khi gửi Email  /  Tự động chuyển tiếp (Quy tắc nâng cao)   /  Tự động thêm lời chào   /  Tự động chia email nhiều người nhận thành các tin nhắn riêng lẻ hữu ích. Cảm ơn !

📨 Quản lý email: Dễ dàng thu hồi email  /  Chặn email lừa đảo theo chủ đề và những người khác  /  Xóa các email trùng lặp  /  Tìm Kiếm Nâng Cao  /  Hợp nhất các thư mục hữu ích. Cảm ơn !

📁 Tệp đính kèm chuyên nghiệpLưu hàng loạt  /  Tách hàng loạt  /  Nén hàng loạt  /  Tự động lưu   /  Tự động tách  /  Tự động nén hữu ích. Cảm ơn !

🌟 Giao diện ma thuật: 😊Thêm nhiều biểu tượng cảm xúc đẹp và thú vị hơn   /  Tăng năng suất Outlook của bạn với chế độ xem theo thẻ  /  Thu nhỏ Outlook thay vì đóng hữu ích. Cảm ơn !

👍 Kỳ quan chỉ bằng một cú nhấp chuột: Trả lời tất cả bằng tệp đính kèm đến  /   Email chống lừa đảo  /  🕘Hiển thị múi giờ của người gửi hữu ích. Cảm ơn !

👩🏼‍🤝‍👩🏻 Danh bạ & Lịch: Thêm hàng loạt liên hệ từ các email đã chọn  /  Chia nhóm liên hệ thành các nhóm riêng lẻ  /  Xóa lời nhắc sinh nhật hữu ích. Cảm ơn !

Trên 100 tính năng Chờ đợi sự khám phá của bạn! Bấm vào đây để khám phá thêm.

 

 

Comments (5)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hi Skyyang,

I'm trying to use the code to import the birthdays into a Sharepoint Events List, which is located in my outlook as calendar, but when i run and then select the calendar the recurrances briefly show up and then vanish again right away.
I did successfully import the recurrances into my personal Calendar but I need it to go to the sharepoint calendar to share it with the company :( any ideas?

kind regards
Jonas
This comment was minimized by the moderator on the site
This is very helpful, thank you! Do you have a specific VBA code for the import, but specifically goes to the "Birthday" calendar in Outlook?

Also, now that I've imported to my calendar, is there an easy way to remove all of those inputted, if needed?

Thank you!
This comment was minimized by the moderator on the site
Hello, Sam,
May be the below VBA code can do you a favor:

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)
Set xCalendarFld = xOlApp.Session.PickFolder
If xCalendarFld.DefaultItemType <> olAppointmentItem Then
  MsgBox "Please Select calendar folder. ", vbOKOnly + vbInformation, "Kutools for Outlook"
  Exit Sub
End If
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


After running this code, you can create a new folder in the calendar, and the imported birthday will be saved in this new folder, if you need to remove the birthdays, you just need go to this folder, and delete them at once.
https://www.extendoffice.com/images/stories/comments/comment-skyyang/2023-comment/doc-import-birthday.png
This comment was minimized by the moderator on the site
Hi Skyyang,

I'm trying to use the code to import the birthdays into a Sharepoint Events List, which is located in my outlook as calendar, but when i run and then select the calendar the recurrances briefly show up and then vanish again right away.
I did successfully import the recurrances into my personal Calendar but I need it to go to the sharepoint calendar to share it with the company :( any ideas?

kind regards
Jonas
This comment was minimized by the moderator on the site
Hi Skyyang,

I'm trying to use the code to import the birthdays into a Sharepoint Events List, which is located in my outlook as calendar, but when i run and then select the calendar the recurrances briefly show up and then vanish again right away.
I did successfully import the recurrances into my personal Calendar but I need it to go to the sharepoint calendar to share it with the company :( any ideas?

kind regards
Jonas
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations