Ako automaticky zlúčiť všetky schôdzky a schôdzky zo všetkých kalendárov pomocou programu Outlook VBA

Ak chcete pre pohodlnú kontrolu vždy spojiť všetky schôdzky a schôdzky zo všetkých kalendárov do jedného kalendára, môžete použiť metódu uvedenú v tomto článku.

Možno máte v Outlooku nakonfigurovaných veľa e-mailových účtov. V takom prípade musíte mať vo svojom Outlooku veľa kalendárov. Preto vždy, keď chcete skontrolovať, koľko je dnes termínov, musíte prepnúť na všetky kalendáre. Bude to trochu nepríjemné. Prečo ich teda nespojíte do jedného kalendára? V nasledujúcich krokoch si ukážeme kúsok kódu VBA, ktorý to môže ľahko realizovať.

Automaticky zlúčiť všetky schôdzky a schôdzky zo všetkých kalendárov

1. Hneď na začiatku spustite aplikáciu Outlook.
2. Po vstupe do hlavného okna programu Outlook stlačte klávesové skratky „Alt + F11“.
3. Potom sa dostanete do okna „Microsoft Visual Basic for Applications“.
4. Ďalej musíte nájsť a otvoriť projekt „ThisOutlookSession“.
5. Následne by ste mali skopírovať a vložiť nasledujúce kódy VBA do tohto okna projektu.

'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. Potom musíte aktuálnemu makru priradiť digitálny certifikát.
7. Neskôr prejdite na „nastavenia makra“, aby ste povolili digitálne podpísané makrá.
8. Nakoniec môžete reštartovať program Outlook, aby ste aktivovali nové makro.
9. Odteraz sa zakaždým, keď sa do iných ako predvolených kalendárov pridá nejaká nová schôdzka alebo schôdza, automaticky skopíruje do predvoleného kalendára, napríklad na nasledujúcom obrázku:

Odstráňte oneskorené položky z kalendára v čase

Ako vieme, program Outlook je náchylnejší na rôzne chyby, keď sa poštová schránka zväčšuje a zväčšuje. Preto sa navrhuje včas odstrániť z poštovej schránky nepotrebné položky, napríklad oneskorené schôdzky a schôdzky. Medzitým je lepšie, ak si v blízkosti necháte silný nástroj na opravu, ako je napr DataNumen Outlook Repair, Môže opraviť Outlook problémy bez toho, aby ste sa zapotili.

Úvod autora:

Shirley Zhang je expertkou na obnovu dát v DataNumen, Inc., ktorá je svetovým lídrom v oblasti technológií obnovy dát, vrátane zotavenie sql a výhľadové softvérové ​​produkty na opravu. Pre viac informácií navštívte www.datanumen. S