Public Sub CreatePattern()
  Dim objAppt As Outlook.AppointmentItem
  Dim objAppt2 As Outlook.AppointmentItem
  Dim myPattern As Outlook.RecurrencePattern
   
   
 Set objAppt = GetCurrentItem()
 If TypeName(objAppt) = "AppointmentItem" Then
  
   Set myPattern = objAppt.GetRecurrencePattern
    myPattern.RecurrenceType = olRecursMonthly
    myPattern.Interval = 3
    myPattern.Occurrences = 5
objAppt.Save
objAppt.Display
      
On Error Resume Next
 
Set objAppt2 = Application.CreateItem(olAppointmentItem)

newdate = DateAdd("m", 11, objAppt.Start) - 1

    With objAppt
        objAppt2.Subject = .Subject & " 2"
        objAppt2.Location = .Location
        objAppt2.Body = .Body
        objAppt2.Start = newdate
        objAppt2.Duration = .Duration
        objAppt2.Categories = .Categories
    End With
      On Error Resume Next
      
objAppt2.Save
objAppt2.Display
        
  
End If
    
    Set objAppt = Nothing
    Set objAppt2 = Nothing
      
 
End Sub