This code sample creates an appointment from an email message and adds it to a shared calendar or a calendar in another data file. It's based off of the Convert email to task macro, but we needed the email added to a shared calendar to create a diary of sorts rather than as a Task.
To use this macro, you also need the GetFolderPath function from this page.
Sub ConvertMailtoAccountAppt() Dim objAppt As Outlook.AppointmentItem Dim objMail As Outlook.MailItem Set objAppt = Application.CreateItem(olAppointmentItem) Set CalFolder = GetFolderPath("mailbox-name\Calendar") For Each objMail In Application.ActiveExplorer.Selection objAppt.Subject = objMail.Subject 'sets it for tomorrow at 9 AM objAppt.Start = DateSerial(Year(Now), Month(Now), Day(Now) + 1) + #9:00:00 AM# objAppt.Body = objMail.Body objAppt.Save objAppt.Move CalFolder Next Set objAppt = Nothing Set objMail = Nothing End Sub
To create the appointment using the message's received time, use
objAppt.Start = objMail.ReceivedTime