Create an Outlook appointment from an email message

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

Related Posts:

1. 

   Move Appointment to Archive Calendar
2. 

   Create tasks for outlook.com and a second Tasks folder
3. Using VBA, you can automatically create a series of Outlook tasks base

   Create a Series of Tasks using VBA
4. 

   Send an email when you add an appointment to your calendar