If you want to always merge all the appointments and meetings from all calendars into one calendar for convenient check, you can apply the method introduced in this article.
Perhaps you have many email accounts configured in your Outlook. In this case, you must have many calendars in your Outlook. Therefore, every time when you want to check how many appointments there are today, you have to switch to all the calendars. It will be a bit troublesome. So, why don’t you merge them into one calendar? In the followings, we will expose a piece of VBA code, which can realize it with ease.
Auto Merge All Appointments & Meetings from All Calendars
- At the very outset, launch your Outlook application.
- After you enter the main Outlook window, press “Alt + F11” key buttons.
- Then you will get into the “Microsoft Visual Basic for Applications” window.
- Next you need to find and open the “ThisOutlookSession” project.
- Subsequently, you ought to copy and paste the following VBA codes into this project window.
'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
- After that, you need to assign a digital certificate to the current macro.
- Later go to “macro settings” to permit the digitally signed macros.
- Eventually, you can restart your Outlook program to activate the new macro.
- From now on, every time when any new appointment or meeting is added in the non-default calendars, it’ll be auto copied to the default calendar, like the following screenshot:
Remove Overdue Items from Calendar in Time
As we know, Outlook is more prone to various errors when the mailbox becomes larger and larger. Therefore, it is suggested to remove useless items from mailbox in time, such as overdue appointments and meetings. In the meantime, it is better if you keep a potent repair tool nearby, such as DataNumen Outlook Repair. It can repair Outlook issues without breaking a sweat.
Shirley Zhang is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including sql recovery and outlook repair software products. For more information visit www.datanumen.com