Outlook VBA yordamida barcha kalendarlardagi barcha uchrashuvlar va uchrashuvlarni qanday avtomatik tarzda birlashtirish mumkin

Agar siz qulay tekshirish uchun har doim barcha kalendarlardagi barcha uchrashuvlar va uchrashuvlarni bitta kalendarga birlashtirmoqchi bo'lsangiz, ushbu maqolada keltirilgan usulni qo'llashingiz mumkin.

Ehtimol, sizning Outlook-da sozlangan ko'plab elektron pochta qayd yozuvlari mavjud. Bunday holda, Outlook-da ko'plab kalendarlar bo'lishi kerak. Shuning uchun, har safar bugun qancha uchrashuv borligini tekshirmoqchi bo'lganingizda, barcha kalendarlarga o'tishingiz kerak. Bu biroz muammoli bo'ladi. Xo'sh, nega ularni bitta kalendarga birlashtirmaysiz? Quyida biz VBA kodining bir bo'lagini ko'rsatamiz, uni osonlik bilan amalga oshirish mumkin.

Barcha kalendarlardan barcha uchrashuvlar va uchrashuvlarni avtomatik birlashtirish

1. Eng boshida Outlook ilovasini ishga tushiring.
2. Asosiy Outlook oynasiga kirganingizdan so'ng, "Alt + F11" tugmachalarini bosing.
3. Keyin siz "Ilovalar uchun Microsoft Visual Basic" oynasiga kirasiz.
4. Keyinchalik siz "ThisOutlookSession" loyihasini topishingiz va ochishingiz kerak.
5. Keyinchalik, ushbu loyiha oynasiga quyidagi VBA kodlaridan nusxa ko'chirishingiz va joylashtirishingiz kerak.

'Here we take two calendars as an example - "Calendar A" & "Calendar B"
'You can add more as per your needs
Dim WithEvents objACalendarItems As Outlook.Items
Dim WithEvents objBCalendarItems As Outlook.Items
Dim objDefaultCalendar As Outlook.Folder
 
Private Sub Application_Startup()
    Set objACalendarItems = Application.Session.folders("File A").folders("Calendar").Items
    Set objBCalendarItems = Application.Session.folders("File B").folders("Calendar").Items

    'Here we merge into the default calendar
    Set objDefaultCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
End Sub
 
Private Sub objACalendarItems_ItemAdd(ByVal Item As Object)
    Call CopyToDefaultCalendar(Item)
End Sub

Private Sub objBCalendarItems_ItemAdd(ByVal Item As Object)
    Call CopyToDefaultCalendar(Item)
End Sub

Private Sub CopyToDefaultCalendar(ByVal objItem As Object)
    Dim objCopiedAppointment As Outlook.AppointmentItem
    Dim objMoviedAppointment As Outlook.AppointmentItem
    Dim strPSTFileName As String
 
    Set objCopiedAppointment = objItem.Copy
    Set objMoviedAppointment = objCopiedAppointment.Move(objDefaultCalendar)
 
    strPSTFileName = objItem.parent.parent.Name
 
    'Tag the source of the copied appointments
    objMoviedAppointment.Categories = "From " & strPSTFileName
    objMoviedAppointment.Save
    'If want to delete it from the original calendar, add the following line:
    'objItem.Delete
End Sub

6. Shundan so'ng, joriy makroga raqamli sertifikatni belgilashingiz kerak.
7. Keyinchalik raqamli imzolangan makroslarga ruxsat berish uchun "makros sozlamalari" ga o'ting.
8. Oxir-oqibat, yangi makrosni faollashtirish uchun Outlook dasturingizni qayta ishga tushirishingiz mumkin.
9. Bundan buyon har safar birlamchi taqvimlarga har qanday yangi uchrashuv yoki uchrashuv qo‘shilsa, u quyidagi skrinshotdagi kabi birlamchi kalendarga avtomatik nusxalanadi:

Taqvimdan muddati o'tgan narsalarni o'z vaqtida olib tashlang

Ma'lumki, pochta qutisi kattaroq va kattalashganda Outlook turli xil xatolarga ko'proq moyil bo'ladi. Shuning uchun pochta qutisidan keraksiz narsalarni, masalan, muddati o'tib ketgan uchrashuvlar va yig'ilishlarni o'z vaqtida olib tashlash tavsiya etiladi. Shu bilan birga, yaqin atrofda kuchli ta'mirlash vositasini saqlasangiz yaxshi bo'ladi DataNumen Outlook Repair. U qila oladi Outlook-ni ta'mirlash ter to'kmasdan muammolar.

Muallif kirish:

Shirli Chjan ma'lumotlarni qayta tiklash bo'yicha mutaxassis DataNumenMa'lumotlarni qayta tiklash texnologiyalari bo'yicha jahon yetakchisi bo'lgan , Inc sqlni tiklash va Outlook ta'mirlash dasturiy mahsulotlar. Qo'shimcha ma'lumot olish uchun tashrif buyuring www.datanumen.com