Automatisches Zusammenführen aller Termine und Besprechungen aus allen Kalendern mit Outlook VBA

Wenn Sie immer alle Termine und Besprechungen aus allen Kalendern zur bequemen Überprüfung in einem Kalender zusammenführen möchten, können Sie die in diesem Artikel vorgestellte Methode anwenden.

Möglicherweise sind in Ihrem Outlook viele E-Mail-Konten konfiguriert. In diesem Fall müssen Sie viele Kalender in Ihrem Outlook haben. Daher müssen Sie jedes Mal, wenn Sie überprüfen möchten, wie viele Termine es heute gibt, zu allen Kalendern wechseln. Es wird ein bisschen mühsam sein. Warum fügst du sie nicht in einem Kalender zusammen? Im Folgenden werden wir einen Teil des VBA-Codes verfügbar machen, der ihn problemlos realisieren kann.

Alle Termine und Besprechungen aus allen Kalendern automatisch zusammenführen

1. Starten Sie gleich zu Beginn Ihre Outlook-Anwendung.
2. Nachdem Sie das Outlook-Hauptfenster aufgerufen haben, drücken Sie die Tasten „Alt + F11“.
3. Anschließend gelangen Sie in das Fenster „Microsoft Visual Basic für Applikationen“.
4. Als nächstes müssen Sie das Projekt "ThisOutlookSession" suchen und öffnen.
5. Anschließend sollten Sie die folgenden VBA-Codes kopieren und in dieses Projektfenster einfügen.

'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. Danach müssen Sie dem aktuellen Makro ein digitales Zertifikat zuweisen.
7. Gehen Sie später zu „Makroeinstellungen“, um die digital signierten Makros zuzulassen.
8. Schließlich können Sie restart Ihr Outlook-Programm, um das neue Makro zu aktivieren.
9. Von nun an wird jedes Mal, wenn ein neuer Termin oder eine neue Besprechung in den nicht standardmäßigen Kalendern hinzugefügt wird, diese automatisch in den Standardkalender kopiert, wie im folgenden Screenshot dargestellt:

Überfällige Elemente rechtzeitig aus dem Kalender entfernen

Wie wir wissen, ist Outlook anfälliger für verschiedene Fehler, wenn das Postfach immer größer wird. Daher wird empfohlen, unbrauchbare Elemente wie überfällige Termine und Besprechungen rechtzeitig aus dem Postfach zu entfernen. In der Zwischenzeit ist es besser, wenn Sie ein wirksames Reparaturwerkzeug in der Nähe haben, z DataNumen Outlook Repair. Es kann Outlook reparieren Probleme, ohne ins Schwitzen zu geraten.

Einführung des Autors:

Shirley Zhang ist eine Datenrettungsexpertin in DataNumen, Inc., das weltweit führend bei Datenwiederherstellungstechnologien ist, einschließlich SQL-Wiederherstellung und Outlook-Reparatursoftwareprodukte. Für weitere Informationen besuchen Sie www.datanumen.com €XNUMX