代码之家 › 专栏 › 技术社区 › sancho.s ReinstateMonicaCellio

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

appointment outlook-vba calendar

0

sancho.s ReinstateMonicaCellio · 技术社区 · 6 年前

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

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

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

official documentation ,我看到的唯一可能的错误源是“在以下情况下,Outlook在调用AddToSelection方法时返回错误:”
但我认为这些都不适用。

错误的可能来源是什么?我如何系统地评估哪一个是我的案例?

我怎么能以一个 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 他们
我不知道有没有更简单的。

1 回复 | 直到 4 年前

1

0

niton 6 年前

回复:我怎样才能选择相同的原始项目作为结束?

具有 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