Applies to Microsoft Outlook 2010, Outlook 2007, Outlook 2003, Outlook 2002
This VBA will copy the selected appointment. Use it to copy recurring events as single appointments to take notes so you can avoid editing the occurrence.
This creates an appointment from the selected occurrence. This code can be used either by selecting a recurring appointment in the Calendar or by opening the occurrence, then running the macro.
You can use VBA to convert a series to individual appointments. See Copy Recurring Appointment Series to Appointments for the code. If you just need a list of dates, see How to print a list of recurring dates using VBA.
Copy Recurring Appointment Code
Public Sub CopyRecurring() Dim oAppt As Outlook.AppointmentItem Dim newAppt As Outlook.AppointmentItem If TypeName(ActiveExplorer.Selection.Item(1)) = "AppointmentItem" Then Set oAppt = GetCurrentItem() Set newAppt = ActiveExplorer.CurrentFolder.Items.Add(olAppointmentItem) newAppt.Start = oAppt.Start newAppt.End = oAppt.End newAppt.Subject = oAppt.Subject & "(Copy)" newAppt.Body = oAppt.Body newAppt.Location = oAppt.Location newAppt.Categories= oAppt.Categories If oAppt.Attachments.Count > 0 Then CopyAttachments oAppt, newAppt End If newAppt.Display Set newAppt = Nothing Else MsgBox "Sorry, you need to select an appointment" End If 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 Sub CopyAttachments(objSourceItem, objTargetItem) Set fso = CreateObject("Scripting.FileSystemObject") Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder strPath = fldTemp.Path & "\" For Each objAtt In objSourceItem.Attachments strFile = strPath & objAtt.FileName objAtt.SaveAsFile strFile objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName fso.DeleteFile strFile Next Set fldTemp = Nothing Set fso = Nothing End Sub