Question

我想编写一个Outlook宏来显示创建的日期和时间以及约会的最后修改。使用我在别处找到的一些代码，我把它拼凑在一起。

我的Outlook 2013日历面板配置为显示两个日历：我的个人日历（使用我的Exchange帐户）和共享组日历（也是Exchange日历）。起初，我对在一个日历中使用约会的结果感到满意，但是当我从其他日历中选择约会并运行宏时，我收到了错误。

错误是-2147221233：方法＆＃39; LastModificationTime＆＃39;对象＆＃39; _AppointmentItem＆＃39;失败。无论哪个第二个日历都会引发错误。

Public Sub lsApptCreated()

    Dim CalFolder As MAPIFolder
    Dim FocalItem As AppointmentItem

    ' Use the selected calendar folder
    Set CalFolder = Application.ActiveExplorer.CurrentFolder

    If CalFolder.DefaultItemType <> olAppointmentItem Then
        Set CalFolder = Nothing
        MsgBox "This macro only works when the current folder is a calendar.", vbOKOnly, _
            "Check Creation Date"
        Exit Sub
    End If

    If Application.ActiveExplorer.Selection.Count <> 1 Then
        Set CalFolder = Nothing
        If Application.ActiveExplorer.Selection.Count = 0 Then
            MsgBox "This macro requires an appointment be selected.", vbOKOnly, _
            "Convert Recurring Appointments"
        Else
            MsgBox "This macro requires a single appointment be selected.", vbOKOnly, _
            "Check Creation Date"
        End If
        Exit Sub
    End If

    Set FocalItem = Application.ActiveExplorer.Selection.Item(1)

    On Error GoTo errhdl

    MsgBox FocalItem.Subject & vbCrLf & vbCrLf _
            & "Date/time created:    " & FocalItem.CreationTime & vbCrLf _
            & "Date/time modified: " & FocalItem.LastModificationTime, _
            vbOKOnly, "Check Creation Date"

    Set FocalItem = Nothing
    Set CalFolder = Nothing

    Exit Sub

errhdl:
    MsgBox "Error " & Err.Number & ": " & Err.Description, _
            vbCritical + vbOKOnly, "Check Creation Date"

    Resume Next

End Sub

因为我对操纵Outlook导航窗格知之甚少，所以我想到了更基本的问题：是否有另一种方法来处理可能保留所有属性的约会？所以我查看了一些代码示例并决定通过EntryID获取它。这很有效：

Public Sub lsApptCreated()

    Dim Namespace As Namespace
    Dim CalFolder As MAPIFolder
    Dim FocalItem As AppointmentItem
    Dim ApptItem As AppointmentItem

    ' Use the selected calendar folder
    Set CalFolder = Application.ActiveExplorer.CurrentFolder

    If CalFolder.DefaultItemType <> olAppointmentItem Then
        Set CalFolder = Nothing
        MsgBox "This macro only works when the current folder is a calendar.", vbOKOnly, _
            "Check Creation Date"
        Exit Sub
    End If

    If Application.ActiveExplorer.Selection.Count <> 1 Then
        Set CalFolder = Nothing
        If Application.ActiveExplorer.Selection.Count = 0 Then
            MsgBox "This macro requires an appointment be selected.", vbOKOnly, _
            "Convert Recurring Appointments"
        Else
            MsgBox "This macro requires a single appointment be selected.", vbOKOnly, _
            "Check Creation Date"
        End If
        Exit Sub
    End If

    'For some reason, when viewing multiple calendars, after you switch
    ' calendars it is not possible to access the LastModificationTime
    ' property using the item returned from the ActiveExplorer.Selection
    ' item. I discovered that instantiating the appointment using
    ' the EntryID gets around the problem.
    Set FocalItem = Application.ActiveExplorer.Selection.Item(1)
    Set Namespace = Application.GetNamespace("MAPI")
    Set ApptItem = Namespace.GetItemFromID(FocalItem.EntryID)

    On Error GoTo errhdl

    MsgBox ApptItem.Subject & vbCrLf & vbCrLf _
            & "Date/time created:    " & ApptItem.CreationTime & vbCrLf _
            & "Date/time modified: " & ApptItem.LastModificationTime, _
            vbOKOnly, "Check Creation Date"

    Set ApptItem = Nothing
    Set Namespace = Nothing
    Set FocalItem = Nothing
    Set CalFolder = Nothing

    Exit Sub

errhdl:
    MsgBox "Error " & Err.Number & ": " & Err.Description, _
            vbCritical + vbOKOnly, "Check Creation Date"

    Resume Next

End Sub

所以我的问题有两个：

为什么我的对象时LastModificationTime属性不存在是从选择中获取的吗？
有没有更优雅的方式来实现我的目标？

谢谢！

如何在显示多个日历时在Outlook VBA中获取约会对象

0 个答案: