我的问题是我在Outlook中有两个单独的帐户。当我接受其中一个的会议时,我希望我的其他日历能够自动通过占位符约会进行预订。我设法(定期)在常规会议上实现了这一目标。但是,我没有复制会议的定期性。
我是Outlook VBA的初学者,所以我确实怀疑自己有些愚蠢。这是我的脚本:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim OutApp As Object
Dim OutMail As Object
Dim MyItem As AppointmentItem
Dim objAppointmentRecurrencePattern As Outlook.RecurrencePattern
Dim MyItemRecurrencePattern As Outlook.RecurrencePattern
'Check if meeting related
If Item.Class = olMeetingResponsePositive Or Item.Class = olMeetingResponseTentative Then
Set MyItem = Item.GetAssociatedAppointment(True)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olAppointmentItem)
Set MyItemRecurrencePattern = MyItem.GetRecurrencePattern
Set objAppointmentRecurrencePattern = OutMail.GetRecurrencePattern
On Error Resume Next
'If the meeting is set for my default account, create an appointment for my secondary account
If Item.SendUsingAccount <> (Environ$("Username") & "@a2.com") Then
For Each oaccount In Application.Session.Accounts
If oaccount = (Environ$("Username") & "test@a2.com") Then
Set Store = oaccount.DeliveryStore
Set Folder = Store.GetDefaultFolder(olFolderCalendar) 'I do this since @a2.com is not the default account(and folder)
With OutMail
.Subject = "Custom"
.Importance = True
.Start = MyItem.Start
.End = MyItem.End
End With
Set objAppointmentRecurrencePattern = MyItemRecurrencePattern 'Copy the reccurance...
OutMail.Move (Folder)
End If
Next
Else 'Below is work in progress, will be more or less copy/paste of the above
With OutMail
.Subject = "Custom"
.Importance = True
.Start = MyItem.Start
.End = MyItem.End
.Save
End With
End If
Else: Exit Sub
End If
End Sub
在观察者中进行调试时,我可以看到objAppointmentRecurrencePattern
与MyItemRecurrencePattern
相同,但是我正在测试的会议设置为星期三,并且产生的约会出现在星期一,但时间不同。我通过一次又一次地“接受”会议系列并选择“立即发送响应”来进行调试。
知道我在做什么错吗?
谢谢!