Question

我有一个Outlook VBA功能，该功能接受选择并处理其项目。我希望它再次选择以前存在的任何选择。

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

在official documentation中，我看到的唯一可能的错误源是“在以下情况下，当您调用AddToSelection方法时，Outlook返回错误：” 但我认为对于我而言，这些都不适用。

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

如何以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。我不知道有没有更简单的方法。

Answer 1

回复：我怎样才能选择相同的原始物品？

对于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

在Outlook VBA日历中选择特定项目

1 个答案: