Выберите определенные элементы в календаре Outlook VBA - PullRequest
Новая
       60

Выберите определенные элементы в календаре Outlook VBA

0 голосов
/ 17 октября 2018

У меня есть функция Outlook VBA, которая принимает выбор и обрабатывает его элементы.Я хочу, чтобы он снова выбрал, какой бы выбор не существовал ранее.

Я догадался, что должен сохранить первоначальный выбор.После обработки первого элемента выбор становится пустым, поэтому я бы использовал AddToSelection для добавления одного элемента за раз.Но я не мог не получить error 438 при его использовании.

Из официальной документации , единственный возможный источник ошибок, который я вижу, это любой из перечисленных в разделе «При следующих условиях 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

EDIT : удаление скобок с аргументом AddToSelection изменило ошибку на указанную в коде.Поэтому я попытался: 1) установить точку останова на этой линии, 2) когда достигнута точка останова, перейти в представлении календаря к неделе newStart, где сейчас находится перемещенный элемент, 3) продолжить.Это работает нормально, так что, кажется, отвечает на вопрос.

Что касается того, как повторно выбрать исходные элементы, я думаю, что я должен: 1) определить минимальную и максимальную даты среди всех оригинальных элементов, 2) установить CalendarView, чтобы охватить эти даты, 3) циклчерез все предметы в исходном выборе и AddToSelection им.Я не знаю, есть ли что-нибудь попроще.

1 Ответ

0 голосов
/ 23 октября 2018

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
...