将会议重复复制到约会中

时间:2020-03-23 17:55:53

标签: vba outlook

我的问题是我在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

在观察者中进行调试时,我可以看到objAppointmentRecurrencePatternMyItemRecurrencePattern相同,但是我正在测试的会议设置为星期三,并且产生的约会出现在星期一,但时间不同。我通过一次又一次地“接受”会议系列并选择“立即发送响应”来进行调试。

知道我在做什么错吗?

谢谢!

0 个答案:

没有答案