Alle afspraken en vergaderingen automatisch samenvoegen uit alle agenda's met Outlook VBA

Als u altijd alle afspraken en vergaderingen uit alle agenda's wilt samenvoegen in één agenda voor gemakkelijke controle, kunt u de methode toepassen die in dit artikel is geïntroduceerd.

Misschien hebt u veel e-mailaccounts geconfigureerd in uw Outlook. In dit geval moet u veel agenda's in uw Outlook hebben. Daarom moet u elke keer dat u wilt controleren hoeveel afspraken er vandaag zijn, overschakelen naar alle agenda's. Het zal een beetje lastig zijn. Waarom voeg je ze dan niet samen in één kalender? In het volgende zullen we een stuk VBA-code blootleggen, waarmee dit gemakkelijk kan worden gerealiseerd.

Alle afspraken en vergaderingen uit alle agenda's automatisch samenvoegen

1. Start vanaf het begin uw Outlook-applicatie.
2. Nadat u het hoofdvenster van Outlook hebt geopend, drukt u op de toetsen "Alt + F11".
3. Vervolgens komt u in het venster "Microsoft Visual Basic for Applications".
4. Vervolgens moet u het project "ThisOutlookSession" zoeken en openen.
5. Vervolgens moet u de volgende VBA-codes kopiëren en in dit projectvenster plakken.

'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. Daarna moet u een digitaal certificaat toewijzen aan de huidige macro.
7. Ga later naar "macro-instellingen" om de digitaal ondertekende macro's toe te staan.
8. Uiteindelijk kun je restart uw Outlook-programma om de nieuwe macro te activeren.
9. Vanaf nu wordt elke keer dat een nieuwe afspraak of vergadering wordt toegevoegd aan de niet-standaardagenda's, deze automatisch gekopieerd naar de standaardagenda, zoals in de volgende schermafbeelding:

Verwijder achterstallige items op tijd uit de kalender

Zoals we weten, is Outlook vatbaarder voor verschillende fouten wanneer de mailbox groter en groter wordt. Daarom wordt aangeraden om nutteloze items, zoals achterstallige afspraken en vergaderingen, tijdig uit de mailbox te verwijderen. In de tussentijd is het beter om een ​​krachtige reparatietool in de buurt te houden, zoals DataNumen Outlook Repair. Het kan reparatie Outlook problemen zonder te zweten.

Auteur Introductie:

Shirley Zhang is een expert op het gebied van gegevensherstel in DataNumen, Inc., de wereldleider in technologieën voor gegevensherstel, waaronder sql herstel en Outlook-reparatiesoftwareproducten. Voor meer informatie bezoek www.datanumen.com