Отфильтрованные события внешнего вида TypeName остаются "Nothing" - PullRequest
Новая
       60

Отфильтрованные события внешнего вида TypeName остаются "Nothing"

0 голосов
/ 23 сентября 2019

Я запускаю макрос в Excel, чтобы заполнить общий календарь Outlook.Дело в том, что у меня нет проблем с добавлением встреч в календарь, но когда даты меняются, я хочу скрыть старые, заменить их новыми событиями.У меня есть код, который должен фильтровать элементы, которые я хочу подавить, но по какой-то причине TypeName моих событий Outlook остается в «Nothing», и я не могу понять, почему.

Здесь - это тестовое событие в моем календаре, которое необходимо подавить.

Вот код: 

Sub SuppressOutlookEvents()
    Dim olApp As Outlook.Application
    Dim objAppointment As Outlook.AppointmentItem
    Dim objAppointments As Outlook.MAPIFolder
    Dim objNameSpace As Outlook.Namespace
    Dim objProperty As Outlook.UserProperty
    Dim OutlookStartTime, OutlookEndTime As Date
    Dim sFilter As Variant

    Worksheets("to_be_removed").Activate

    OutlookStartTime = DateValue("10-15-2019")

    Set olApp = CreateObject("Outlook.Application")
    Set objNameSpace = olApp.GetNamespace("MAPI")
    Set objAppointments = objNameSpace.GetDefaultFolder(olFolderCalendar)

    sFilter = "[Start] =  OutlookStartTime And [Subject] = 'Test'"

    Set objAppointment = objAppointments.Items.Find(sFilter)

    ```
    MsgBox (TypeName(objAppointment)) 'Here it displays "Nothing" 
    If Not TypeName(objAppointment) = "Nothing" Then
        objAppointment.Delete
    End If
    ```

    Set objAppointment = Nothing
    Set objAppointments = Nothing

End Sub

Я не знаю, распознает ли фильтрсобытие или, если это по другой причине ...

РЕДАКТИРОВАТЬ: благодаря ответам у меня наконец есть рабочий код: 

Sub suppress_outlook_event(Optional row As Integer = 2)
    Dim olApp As Outlook.Application
    Dim objAppointments As Outlook.MAPIFolder
    Dim objNameSpace As Outlook.Namespace
    Dim objProperty As Outlook.UserProperty
    Dim OutlookStartTime, OutlookEndTime As Date
    Dim sFilter As Variant

    OutlookStartTime = Format("09/19/19" & " " & "8:00 AM", "mm/dd/yyyy hh:mm AMPM")

    Set olApp = CreateObject("Outlook.Application")
    Set objNameSpace = olApp.GetNamespace("MAPI")
    Set objAppointments = objNameSpace.GetDefaultFolder(olFolderCalendar)

    o_title = "Example"
    sFilter = "[Subject] = " & Chr(34) & o_title & Chr(34)

    objAppointments.Items.IncludeRecurrences = True
    objAppointments.Items.Sort "[Start]"

    Set objAppointment = objAppointments.Items.Restrict(sFilter)
    objAppointment.IncludeRecurrences = True

    If Not objAppointment.Count = 0 Then
        obj_count = objAppointment.Count
        For i = 1 To obj_count
            objAppointment(obj_count + 1 - i).Delete
        Next i
    End If

    Set objAppointment = Nothing
    Set objAppointments = Nothing

End Sub

1 Ответ

0 голосов
/ 23 сентября 2019

Этот вопрос должен быть закрыт как дубликат, однако я внес необходимые изменения в ваш код.

Ключевые моменты при использовании функции «Найти или ограничить встречи».

  1. Убедитесь, что для свойства IncludeRecurferences установлено значение True
  2. . Убедитесь, что дата / время отформатированы, как показано ниже, ианализируется как строка, а не как фактическое значение даты / времени.

Я немного скептически отношусь к тому, как он будет обрабатывать несколько встреч с одной и той же темой и датой начала (если время непоставленные или противоречивые назначения существуют).Прошлый опыт показывает, что он просто вернет первый.Поэтому может быть лучше использовать метод Restrict и выполнить итерацию возвращенной коллекции элементов, в противном случае вы рискуете пропустить встречу.

Items. Ограничить встречи в календаре Outlook (VBA) 

Sub SuppressOutlookEvents()
    Dim olApp As Outlook.Application
    Dim objAppointment As Outlook.AppointmentItem
    Dim objAppointments As Outlook.MAPIFolder
    Dim objNameSpace As Outlook.NameSpace
    Dim objProperty As Outlook.UserProperty
    Dim OutlookStartTime, OutlookEndTime As Date
    Dim sFilter As Variant

    Worksheets("to_be_removed").Activate

    OutlookStartTime = Format("9-24-2019 12:30PM", "mm/dd/yyyy hh:mm AMPM")

    Set olApp = CreateObject("Outlook.Application")
    Set objNameSpace = olApp.GetNamespace("MAPI")
    Set objAppointments = objNameSpace.GetDefaultFolder(olFolderCalendar)

    sFilter = "[Start] =  '" & OutlookStartTime & "' And [Subject] = 'test'"


    objAppointments.Items.IncludeRecurrences = True
    objAppointments.Items.Sort "[Start]"


    Set objAppointment = objAppointments.Items.Find(sFilter)


    MsgBox (TypeName(objAppointment)) 'Here it displays "Nothing"
    If Not TypeName(objAppointment) = "Nothing" Then
        objAppointment.Delete
    End If


    Set objAppointment = Nothing
    Set objAppointments = Nothing

End Sub
...