使用VBA宏复制outlook中的定期约会

Question

如何使用VBA将Outlook 2013中的定期约会复制到该工具中？我尝试将源项目的RecurrencePattern对象复制到目标项目（cAppt），但是这将开始日期设置为下一个即时日历间隔（例如，如果现在是4:12，则重复系列设置为从今天4:30）而不是原始项目的实际开始日期。如何做到这一点的任何提示？

Private Sub curCal_ItemAdd(ByVal Item As Object) 
Dim cAppt As AppointmentItem 
Dim oPatt As RecurrencePattern 
Dim cPatt As RecurrencePattern 
Dim moveCal As AppointmentItem 

' On Error Resume Next 

'only copy items not marked as private 
If Item.Sensitivity <> olPrivate Then 

    Item.Body = Item.Body & "[" & GetGUID & "]" 
    Item.Save 

Set cAppt = Application.CreateItem(olAppointmentItem) 
If Item.IsRecurring Then 
    Set cPatt = cAppt.GetRecurrencePattern 
    cPatt = Item.GetRecurrencePattern 
End If 

With cAppt 
    .Subject = Item.Subject 
    .Start = Item.Start 
    .Duration = Item.Duration 
    .Location = Item.Location 
    .Body = Item.Body 
End With 

' set the category after it's moved to force EAS to sync changes 
Set moveCal = cAppt.Move(newCalFolder) 
moveCal.Categories = "moved" 
moveCal.Save 

End If 
End Sub 

Answer 1

尝试使用AppointmentItem.Copy而不是Application.CreateItem。