Ugrás a tartalomra

Hogyan importálhatok születésnapokat az Excelből az Outlook naptárba?

Ha egy munkalapon hosszú listája van a születésnapi adatokról, most eseményként szeretné importálni ezeket a születésnapokat az Outlook-naptárba. Hogyan tudná megoldani ezt a feladatot néhány gyors módszerrel?


Születésnapok importálása Excelből az Outlook naptárba VBA-kóddal

Általában nincs közvetlen mód a születésnapok importálására az Outlook naptárba, itt létrehozok egy VBA-kódot a probléma megoldására, kérjük, tegye a következőket:

1. Nyissa meg az Outlookba importálni kívánt születésnapokat tartalmazó munkalapot, majd tartsa lenyomva a gombot ALT + F11 billentyűk megnyitásához Microsoft Visual Basic for Applications ablak.

2. Kattints betétlap > Modulok, és illessze be a következő kódot a Modul ablakba.

VBA-kód: Születésnapok importálása az Outlook naptárba

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. Még mindig a Microsoft Visual Basic for Applications ablakban kattintson Eszközök > Referenciák. A kiugrott Referenciák - VBAProject párbeszédpanelen ellenőrizze Microsoft Outlook 16.0 objektumkönyvtár opció formájában a Elérhető referenciák lista mező, lásd a képernyőképet:

4. Ezután kattintson OK a párbeszédpanel bezárásához. Most nyomja meg F5 gombot a kód futtatásához, és megjelenik egy prompt mező, válassza ki a nevet és a születésnapot oszlopokat, lásd a képernyőképet:

5. Ezután kattintson OK gombot, a születésnapok egyszerre importálódnak az Outlook naptárba, elindíthatja az Outlookot az eredmény megtekintéséhez, lásd a képernyőképet:


A legjobb irodai hatékonyságnövelő eszközök

Kutools az Outlook számára - Több mint 100 hatékony funkció az Outlook feltöltéséhez

???? E-mail automatizálás: Hivatalon kívül (POP és IMAP esetén elérhető)  /  Ütemezze az e-mailek küldését  /  Automatikus CC/BCC szabályok szerint e-mail küldésekor  /  Automatikus továbbítás (Speciális szabályok)   /  Automatikus üdvözlet hozzáadása   /  A több címzettnek szóló e-mailek automatikus felosztása egyedi üzenetekre ...

📨 Email Management: Könnyen visszahívhatja az e-maileket  /  Blokkolja az alanyok és mások átverő e-mailjeit  /  Törölje az ismétlődő e-maileket  /  Részletes keresés  /  Mappák összevonása ...

📁 Attachments ProKötegelt mentés  /  Batch Detach  /  Batch tömörítés  /  Automatikus mentés   /  Automatikus leválasztás  /  Automatikus tömörítés ...

🌟 Interface Magic: 😊További szép és menő hangulatjelek   /  Növelje Outlook termelékenységét a füles nézetekkel  /  Minimalizálja az Outlookot a bezárás helyett ...

👍 Csodák egy kattintással: Válasz mindenkinek a bejövő mellékletekkel  /   Adathalászat elleni e-mailek  /  🕘A feladó időzónájának megjelenítése ...

👩🏼‍🤝‍👩🏻 Névjegyek és naptár: Névjegyek kötegelt hozzáadása a kiválasztott e-mailekből  /  Egy kapcsolattartó csoport felosztása egyéni csoportokra  /  Távolítsa el a születésnapi emlékeztetőket ...

Több, mint 100 Jellemzők Várja felfedezését! Kattintson ide, ha többet szeretne megtudni.

 

 

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