I have a couple of similar code samples on another page - one of the macros copies a cancelled meeting to an appointment, the other copies a meeting before the organizer cancels it. This macro just copies a meeting request to an appointment.

Why would you want to copy a meeting? In my case, to add it to the calendar that syncs with my blackberry. If I forward the meeting, my default address is exposed to the organizer. Meeting organizers might want a copy they can use to block off time before or after the meeting, or to use for meeting notes.

iCloud users may want to copy appointments instead of meeting to avoid issues with the iCloud sending out meeting invitations.

This code sample uses the GetCurrentItem function (included) and works with either selected meetings or opened meetings.

Copy Meeting to an Appointment

To use, open the VBA Editor and paste the code into a module. Select a meeting them run the macro.

Sub copyMeeting()
 
Dim oAppt As AppointmentItem
Dim cAppt As AppointmentItem
 
Set cAppt = GetCurrentItem()
Set oAppt = Application.CreateItem(olAppointmentItem)
     
     
    oAppt.Subject = "Copied: " & cAppt.Subject
    oAppt.Start = cAppt.Start
    oAppt.Duration = cAppt.Duration
    oAppt.Location = cAppt.Location
    oAppt.Save
     
    Set oAppt = Nothing
    Set cAppt = Nothing
 
 
End Sub
 
Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
          
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
      
    Set objApp = Nothing
End Function

Copy appointments to a different calendar

If you are using this macro to copy meetings as appointments to another calendar, such as the iCloud, you need to tweak the code to use folders in other data stores.

You will need to get the code at Working with VBA and non-default Outlook Folders to set the folder to the iCloud folder. Paste it in the VB Editor, at the end of this code.

Note: This will work with any data file, not just iCloud. Change the path in the objCalendarFolder line to use the name of the data file (as seen in the Folder list) and calendar path.

Sub copyMeetingtofolder()

Dim objCalendarFolder As Outlook.Folder
Dim oAppt As AppointmentItem
Dim cAppt As AppointmentItem
 
Set cAppt = GetCurrentItem()
Set oAppt = Application.CreateItem(olAppointmentItem)
     
     
     Set objCalendarFolder = GetFolderPath("iCloud\calendar")
     
     
    oAppt.Subject = "Copied: " & cAppt.Subject
    oAppt.Start = cAppt.Start
    oAppt.Duration = cAppt.Duration
    oAppt.Location = cAppt.Location
    oAppt.Save

    oAppt.Move objCalendarFolder
     
    Set oAppt = Nothing
    Set cAppt = Nothing
 Set objCalendarFolder = Nothing
 
End Sub
 
Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
          
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
      
    Set objApp = Nothing
End Function

Block off travel time

You can use macros similar to the code on these pages to block off travel time by changing the fields.

    oAppt.subject = "downtime: " & cAppt.subject
    oAppt.Start = cAppt.End
    oAppt.Duration = 15