Save appointments to a non-default Outlook calendar folder

To use this macro with a calendar in another folder (such as to move appointments to a hotmail or iCloud calendar), you need to use the function found at Working with VBA and non-default Outlook Folders. Instructions to use other calendar folders in your default data file are there also.

Replace pst-display-name with the name as seen in the folder list.

For a version of this macro that copies new appointments that have Show time as set to Busy to another calendar, see Copy new appointments to another calendar using VBA

To use with Contacts, use olFolderContacts instead of olFolderCalendar.

Create Tasks from Email and move to different Task folders

VBA: Move Appointments to a different calendar

To use, check your Macro security setting; it needs to be on low while testing. Press Alt+F11 to open the VBA Editor. Expand the project folder and paste this into ThisOutlookSession. If you are moving the appointments to a different pst or data file, you will need to get the function from this page. It can be pasted at the end of ThisOutlookSession or you can insert a Module and paste it into the module.

To test: Click in the Application_Start then click the Run button. Open the default Inbox and create an appointment. Check the Calendar folders. Is the appointment in the desired folder?

Dim WithEvents newCal As Items
 
Private Sub Application_Startup()
   Dim NS As Outlook.NameSpace
   Set NS = Application.GetNamespace("MAPI")
   Set newCal = NS.GetDefaultFolder(olFolderCalendar).Items
   Set NS = Nothing
End Sub
 
Private Sub newCal_ItemAdd(ByVal Item As Object)

Set CalFolder = GetFolderPath("datafile-display-name\Calendar")
Item.Move CalFolder
End Sub

Move contacts to a different folder

The same method can be used with contacts. Don't forget, if you are moving the appointments to a different pst or data file, you will need to get the function from this page.

Dim WithEvents newContact As Items
 
Private Sub Application_Startup()
   Dim NS As Outlook.NameSpace
   Set NS = Application.GetNamespace("MAPI")
   Set newContact = NS.GetDefaultFolder(olFolderContact).Items
   Set NS = Nothing
End Sub
 
Private Sub newContact_ItemAdd(ByVal Item As Object)

Set ContactFolder = GetFolderPath("datafile-display-name\Contacts")
Item.Move ContactFolder
End Sub

Move Tasks to a different folder

Don't forget, if you are moving the appointments to a different pst or data file, you will need to get the function from this page.

Dim WithEvents newTasks As Items
 
Private Sub Application_Startup()
   Dim NS As Outlook.NameSpace
   Set NS = Application.GetNamespace("MAPI")
   Set newTasks = NS.GetDefaultFolder(olFolderTasks).Items
   Set NS = Nothing
End Sub
 
Private Sub newTasks_ItemAdd(ByVal Item As Object)

Set TaskFolder = GetFolderPath("datafile-display-name\Tasks")
Item.Move TaskFolder
End Sub