Як автоматично об'єднати всі зустрічі та зустрічі з усіх календарів за допомогою Outlook VBA

Якщо ви хочете завжди об’єднувати всі зустрічі та зустрічі з усіх календарів в один календар для зручної перевірки, ви можете застосувати метод, представлений у цій статті.

Можливо, у вас багато облікових записів електронної пошти, налаштованих у вашому Outlook. У цьому випадку у вашому Outlook має бути багато календарів. Тому кожного разу, коли ви хочете перевірити, скільки зустрічей є сьогодні, вам доводиться переходити на всі календарі. Це буде трохи клопітно. То чому б вам не об’єднати їх в один календар? Далі ми розкриємо фрагмент коду VBA, який може легко його реалізувати.

Автоматично об’єднати всі зустрічі та зустрічі з усіх календарів

1. З самого початку запустіть програму Outlook.
2. Після входу в головне вікно Outlook натисніть кнопки Alt + F11.
3. Потім ви потрапите у вікно “Microsoft Visual Basic for Applications”.
4. Далі вам потрібно знайти та відкрити проект “ThisOutlookSession”.
5. Згодом вам слід скопіювати та вставити наступні коди VBA у це вікно проекту.

'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. Після цього вам потрібно призначити цифровий сертифікат поточному макросу.
7. Пізніше перейдіть до «Налаштування макросів», щоб дозволити макроси з цифровим підписом.
8. Зрештою, ви можете перезапустити програму Outlook, щоб активувати новий макрос.
9. Відтепер кожного разу, коли будь-яку нову зустріч чи зустріч додають у календарі, що не відповідають замовчуванню, вони автоматично копіюються до календаря за замовчуванням, як на наступному скріншоті:

Видаліть прострочені елементи з календаря вчасно

Як ми знаємо, Outlook стає більш схильним до різних помилок, коли поштова скринька стає все більшою і більшою. Тому пропонується вчасно видаляти з поштової скриньки непотрібні предмети, наприклад, прострочені зустрічі та зустрічі. Тим часом краще, якщо ви тримаєте поруч потужний інструмент для ремонту, наприклад DataNumen Outlook Repair. Він може ремонт Outlook проблеми, не потіючи піт.

Вступ автора:

Ширлі Чжан - експерт із відновлення даних у DataNumen, Inc., яка є світовим лідером у галузі технологій відновлення даних, в тому числі відновлення SQL та перспективні програмні продукти для ремонту. Для отримання додаткової інформації відвідайте WWW.datanumen.com