查找Outlook MeetingItem的基础对象类型

时间:2010-12-06 11:27:11

标签: outlook-vba

我正在使用VBA扫描MAPIFolders以查找在特定日期之前创建的Items,以便将其移至存档PST。通常Item.CreationDate是扫描“旧”Outlook项目的好钩子,但对于日历条目,“创建日期”可以在“开始日期”之前,因此对于日历条目,我宁愿使用后者。 / p>

我的问题是MeetingItem类型,可以是

  • .GetAssociatedAppointment(False)似乎正常工作的约会
  • 对收到的.GetAssociatedAppointment(False)崩溃
  • 的约会的接受消息

知道如何区分上述情况以在Set语句中使用正确的底层对象类型吗?

注意:尝试在Set之后检查调试器中的E总是会导致“Outlook遇到问题并需要关闭...”

Private Function TimeOf(I As Object) As Date

Dim A As AppointmentItem
Dim M As MailItem
Dim E As MeetingItem
Dim T As TaskItem
Dim C As TaskRequestAcceptItem
Dim D As TaskRequestDeclineItem
Dim Q As TaskRequestItem
Dim U As TaskRequestUpdateItem

    Select Case TypeName(I)
    Case "AppointmentItem"
        Set A = I
        TimeOf = A.Start
        Set A = Nothing

    Case "MailItem"
        Set M = I
        TimeOf = M.ReceivedTime
        Set M = Nothing

    Case "MeetingItem"
        Set E = I
        Set A = E.GetAssociatedAppointment(False) ' doesn't work if item is a
                                                  ' response to an Appointment received
        TimeOf = A.Start                          ' <-- ERROR: Object variable ... not set
        Set E = Nothing
        Set A = Nothing

    Case "TaskItem"
        Set T = I
        TimeOf = T.Start
        Set T = Nothing

    Case "TaskRequestAcceptItem"
        Set C = I
        TimeOf = C.Start
        Set C = Nothing

    Case "TaskRequestDeclineItem"
        Set D = I
        TimeOf = D.Start
        Set D = Nothing

    Case "TaskRequestItem"
        Set Q = I
        TimeOf = Q.Start
        Set Q = Nothing

    Case "TaskRequestUpdateItem"
        Set U = I
        TimeOf = U.Start
        Set U = Nothing

    Case Else
        TimeOf = I.CreationTime
    End Select

End Function

1 个答案:

答案 0 :(得分:1)

请求类型MeetingItem的MessageClass为“IPM.Schedule.Meeting.Request”。 MeetingItem的接受类型具有MessageClass“IPM.Schedule.Meeting.Resp.Pos”。有关Outlook 2003上其他MessageClass的更多详细信息,请参阅here。我在Outlook 2007中测试了以下代码。它工作正常。

Private Function TimeOf(I As Object) As Date

Dim A As AppointmentItem
Dim M As MailItem
Dim E As MeetingItem
Dim T As TaskItem
Dim C As TaskRequestAcceptItem
Dim D As TaskRequestDeclineItem
Dim Q As TaskRequestItem
Dim U As TaskRequestUpdateItem

    Select Case TypeName(I)
    Case "AppointmentItem"
        Set A = I
        TimeOf = A.Start
        Set A = Nothing

    Case "MailItem"
        Set M = I
        TimeOf = M.ReceivedTime
        Set M = Nothing

    Case "MeetingItem"
        Set E = I
        If (E.MessageClass = "IPM.Schedule.Meeting.Request") Then
            ' Meeting Request
            Set A = E.GetAssociatedAppointment(False)
            TimeOf = A.Start
            Set A = Nothing
        Else
            ' Other MeetingItem
            TimeOf = E.ReceivedTime
        End If
        Set E = Nothing

    Case "TaskItem"
        Set T = I
        TimeOf = T.Start
        Set T = Nothing

    Case "TaskRequestAcceptItem"
        Set C = I
        TimeOf = C.Start
        Set C = Nothing

    Case "TaskRequestDeclineItem"
        Set D = I
        TimeOf = D.Start
        Set D = Nothing

    Case "TaskRequestItem"
        Set Q = I
        TimeOf = Q.Start
        Set Q = Nothing

    Case "TaskRequestUpdateItem"
        Set U = I
        TimeOf = U.Start
        Set U = Nothing

    Case Else
        TimeOf = I.CreationTime
    End Select

End Function