处理项目后重新选择日历中的项目答案

【问题标题】：Reselect items in Calendar after processing the items处理项目后重新选择日历中的项目
【发布时间】：2019-03-21 20:23:10
【问题描述】：

我有一个 Outlook VBA 函数，它接受一个选择并处理其项目。

我希望它再次选择之前存在的任何选择。

我猜我必须存储初始选择。处理完第一个项目后，Selection 变为空，因此我将使用 AddToSelection 一次添加一个项目。
但我无法避免得到error 438。

来自official documentation，我看到的唯一可能的错误来源是“在以下情况下，Outlook 在您调用 AddToSelection 方法时返回错误：”中列出的任何错误：
但我认为这些都不适用。

可能的错误来源是什么？我如何系统地评估我的情况？

我怎样才能以 Selection 的相同原始项目结束？

我的功能（这里适用于带有单个项目的Selection）：

Sub MoveAppt()
' Move selected appointment a given number of days within the Calendar
    Dim sel As Outlook.Selection, xpl As Explorer
    Dim oOlAppt As Outlook.AppointmentItem
    Set xpl = Application.ActiveExplorer
    Set sel = xpl.Selection
    Set oOlAppt = sel.Item(1)
    Dim newStart As Date
    Dim ndays As Integer
    ndays = 7
    newStart = MoveAppointment(oOlAppt, ndays)

    Debug.Print "Count = " & xpl.Selection.Count    ' THIS GIVES 0, CONFIRMING AN EMPTY Selection
    If (xpl.IsItemSelectableInView(oOlAppt)) Then   ' <----- THIS RETURNS True ...
        xpl.AddToSelection oOlAppt                  ' <----- ... BUT THIS GIVES ERROR -2147467259 (80004005)
    Else
        Debug.Print "Object is not selectable"
    End If
End Sub

Function MoveAppointment(ByRef oOlAppt As Outlook.AppointmentItem, ByVal ndays As Integer) As Date
' Move an Outlook.AppointmentItem a given number of days within the Calendar
    With oOlAppt
        Dim currStart As Date, newStart As Date
        currStart = .Start
        newStart = DateAdd("d", ndays, currStart)
        .Start = newStart
        .Save
    End With
    MoveAppointment2 = newStart
End Function

编辑：
删除 AddToSelection 参数的括号将错误更改为代码中指示的错误。
所以我尝试了：1）在该行设置断点，2）当断点被击中时，在日历视图中转到 newStart 的那一周，即现在移动的项目所在的位置，3）继续。这运行正常，所以它似乎回答了这个问题。

至于如何重新选择原始项目，我想我应该：1）确定所有原始项目中的最小和最大日期，2）设置 CalendarView 以覆盖这些日期，3）遍历所有项目在原始选择中和AddToSelection他们。
不知道有没有更简单的。

【问题讨论】：

见How to create a Minimal, Complete, and Verifiable example。添加用于调用函数和 MoveAppointment 的代码。
xpl.AddToSelection apptmts。 apptmts 周围没有括号，后来 oOlAppt 周围没有括号
真正的问题似乎是，为什么选定的项目在 MoveAppointment 中被取消选择？
@niton - #1：创建了一个 MCVE。
@niton - #2：完成。这将错误代码更改为更合理的内容，并有助于揭示另一个问题，该问题已解决。请参阅编辑。

标签： vba outlook calendar appointment

【解决方案1】：

Re：如何以相同原始项目的选择结束？

对于Set sel = xpl.Selection，sel 是相同原始项目的选择。

Sub MoveAppt_SelOnly()

    ' Move selected appointment a given number of days within the Calendar

    Dim xpl As Explorer
    Dim sel As Selection
    Dim ndays As Long

    Set xpl = ActiveExplorer

    If xpl.Selection(1).Class = olAppointment Then

        If xpl.Selection(1).subject = "test" Then

            Debug.Print
            Debug.Print "xpl.Selection.count ....: " & xpl.Selection.count
            Debug.Print "xpl.Selection(1).subject: " & xpl.Selection(1).subject
            Debug.Print "xpl.Selection(1).start..: " & xpl.Selection(1).Start

            Set sel = xpl.Selection
            Debug.Print "sel(1).subject..........: " & sel(1).subject
            Debug.Print "sel(1).start............: " & sel(1).Start

            ndays = 7

            MoveAppointment sel(1), ndays

            Debug.Print
            Debug.Print "xpl.Selection.count ....: " & xpl.Selection.count
            Debug.Print "sel(1).subject..........: " & sel(1).subject
            Debug.Print "sel(1).start.........new: " & sel(1).Start

            ' For testing. Be sure the item is not in the view after this first move
            '  otherwise you do not lose track of xpl.Selection.
            MsgBox "The moved item should not be in the view." & vbCr & _
                "xpl.Selection.count ....: " & xpl.Selection.count & vbCr & _
                "sel(1).subject..........: " & sel(1).subject & vbCr & _
                "sel(1).start.........new: " & sel(1).Start

            Debug.Print
            ' If you see zero here it does not matter
            Debug.Print "xpl.Selection.count ....: " & xpl.Selection.count

            Debug.Print "sel(1).subject..........: " & sel(1).subject
            Debug.Print "sel(1).start.........new: " & sel(1).Start

            ' Return the item to where it started, using sel,
            '   a "Selection of the same original items".
            MoveAppointment sel(1), ndays * (-1)

            MsgBox "The moved item should be in the view now." & vbCr & _
                "xpl.Selection.count ....: " & xpl.Selection.count & vbCr & _
                "sel(1).subject..........: " & sel(1).subject & vbCr & _
                "sel(1).start....original: " & sel(1).Start

            Debug.Print
            ' If you see zero here it does not matter
            Debug.Print "xpl.Selection.count ....: " & xpl.Selection.count

            Debug.Print "sel(1).subject..........: " & sel(1).subject
            Debug.Print "sel(1).start....original: " & sel(1).Start

        End If

    End If

End Sub


Sub MoveAppointment(ByRef oOlAppt As AppointmentItem, ByVal ndays As Long)

    ' Move an AppointmentItem a given number of days within the Calendar

    Dim newStart As Date

    With oOlAppt
        oOlAppt.Start = DateAdd("d", ndays, oOlAppt.Start)
        .Save
    End With

End Sub

【讨论】：