Vba 查找Outlook MeetingItem的基础对象类型

我正在使用VBA扫描

MAPI文件夹

，查找在特定日期之前创建的

项目

，以便将它们移动到存档PST。通常情况下，

Item.CreationDate

是扫描“旧”Outlook项目的好钩子，但对于日历条目，“创建日期”可能早于“开始日期”，因此对于日历条目，我更希望使用后者

我的问题是类型

MeetingItem

，它可以

• .GetAssociatedAppointment（False）

  似乎可以正常工作的约会
• 接收到的约会的接受消息，其中

  .GetAssociatedAppointment（False）

  崩溃

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

注意：在设置了

后尝试在调试器中检查E总是会导致“Outlook遇到问题，需要关闭…”

私有函数TimeOf（I作为对象）作为日期
将A设为委任项目
将M设置为邮件项
将E作为会议项目
将T设置为任务项
Dim C作为TaskRequestAcceptItem
Dim D作为TaskRequestDeclineItem
将Q设置为TaskRequestItem
将U设置为TaskRequestUpdateItem
选择案例类型名称（I）
案例“任命项目”
设置A=I
TimeOf=A.开始
设置A=无
案例“MailItem”
设置M=I
TimeOf=M.ReceivedTime
设置M=无
案例“会议项目”
设置E=I
如果项目为A，则设置A=E.GetAssociatedAppointment（False）'不起作用
"对预约的回应
TimeOf=A.Start'请求类型MeetingItem的MessageClass为“IPM.Schedule.Meeting.request”。MeetingItem的接受类型的MessageClass为“IPM.Schedule.Meeting.Resp.Pos”。有关Outlook 2003上其他MessageClass的详细信息，请参阅。我在Outlook2007中测试了以下代码。很好用

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

您好&谢谢您的回复；很抱歉，我现在不能测试，因为我在圣诞假期，但我相信你的解释，因此接受你的解决方案。将在一月初公布结果。节日问候-麦克风
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