Outlook : Calendar : метод Find не желает искать

[skiperski]

Трям! Давненько не заходил.

Тут вопросы назрели. Нужно периодически содержимое папки Календарь сливать во внешний файл. Здесь нашёл пример работы с оутглюком. Уже спасибо. Получилось вот что:

Код: Выделить всё

Option Explicit

Sub new_ask_makros()

    Dim s$
    Dim oNS As Outlook.NameSpace
    Dim oCalendar As Outlook.MAPIFolder
    Dim oAppointment As Outlook.AppointmentItem
   
    Set oNS = Outlook.Application.GetNamespace("mapi")
    Set oCalendar = oNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)
   
    For Each oAppointment In oCalendar.Items
        s = s & oAppointment.Start & " "
        s = s & oAppointment.Subject & vbNewLine
    Next

    Debug.Print s

End Sub


Т.е. доступ к календарю у меня уже есть. Это уже хорошо. Проблема в том, что во-первых, Item'ы упорядочены по времени их создания, во-вторых, их может быть много, а нужны лишь за апределённый период. Пробовал Find и Sort как рекомендуют здесь, но чего-то пока не работает. Делал так:

Код: Выделить всё

    oCalendar.Items.Sort "[Start]"

и так

Код: Выделить всё

    oCalendar.Items.GetFirst
    Set v = oCalendar.Items.Find("[Subject] = 'test")

В первом случае не сортирует, во втором ищет только полное совпадение, а на Like ругается: "Не верные условия". А как искать по полю типа Date, например Start, я вообще не знаю. На такое вот ругается "Конфликт типов или значение "12/08/2006 13:30:00" в условии не верно"

Код: Выделить всё

    Set v = oCalendar.Items.Find("[Start] = '12/08/2006 13:30:00'")

А на такое

Код: Выделить всё

    Set v = oCalendar.Items.Find("[Start] = #12/08/2006 13:30:00#")

"Конфликт типов или значение "0" в условии не верно"

Т.е. надо всё ручками в цикле проверять, а записей может быть много, да и не красиво как-то.


Это было раз. Теперь нумбер два. Что бы каждый раз не лопатить все значения, можно же повесить обработчик на событие. Вот чего получилось

Код: Выделить всё

Dim WithEvents moCalendarItems As Outlook.Items

Private Sub Application_MAPILogonComplete()
   
    Dim oNS As Outlook.NameSpace
   
    Set oNS = Outlook.Application.GetNamespace("mapi")
    Set moCalendarItems = oNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar).Items
   
End Sub

Правильно ли я сделал или надо как-то по другому? Кроме того это всё работает только при уровнях безопасности низкий и очень низкий, а для высокого и супер-пупер -- автоматически выключаются, если не подписаны какой-то там сигнатурой. Гиде её взять?

[skiperski]

Народ, вы хоть головой кивните. Find и Sort вообще работают или просто для красоты? Или это у меня руки кривые? Можете смело так и говорить, но уже скажите же хоть что-нибудь!

Знаю, что апаю, но скоро Новый год, и потом вообще никого не дождусь.

[GSerg]

Меня, наверное, и в новый год дождёшься, только я не знаю про outlook

[skiperski]

GSerg, спасибо за участие.

Я думаю, что разницы нет Outlook это или Excel, т.к. метод Find заявлен в них обоих. Если работает где-то, то должен работать и в Outlook'е.

Собственно, если до завтра не узнаю результата, то потом можно и не торопиться, т.к. послезавтра мой последний рабочий день на этой фирме. А за один оставшийся рабочий день мне задание не доделать.

Просто всё до этого момента выполнялось на раз-два, а тут затык вышел. Не хотелось бы в последний день испортить репутацию, но с VBA в чистом виде я ни разу ещё не работал. Ладно, переживу. Никто, кроме вас, не узнает о моём позоре.

[skiperski]

Для облегчения, сгруппирую вопросы

1. Метод Find: поиск по неполному соответствию (Like)

2. Метод Find: работа с датами

3. Метод Sort: хоть что-нибудь

4. Digital Signatur: как подписать или где взять

[skiperski]

1. Метод Find: поиск по неполному соответствию (Like)

Пока ничего не нашёл, но оказалось и не нужным.

2. Метод Find: работа с датами

Код: Выделить всё

sFilter = "[LastModificationTime] > '" & Format(Date, "ddddd h:nn AM/PM") & "'"

Кстати, на странице по ссылке ниже ошибка (потерялся слэш в AM/PM), здесь правильно.

3. Метод Sort: хоть что-нибудь

Работает только в связке с методом Restrict

Примеры см. здесь Using Find and Restrict to Retrieve Items

4. Digital Signatur: как подписать или где взять

Читать тут: Вопросы безопасности при использовании макросов в приложениях Microsoft Office

[skiperski]

Вот что в итоге получилось.

Задача: отслеживать назначенные встречи в определённых местах на неделю с текущего дня и сохранять куда-нибудь для последующего отображения на странице интранета.

Код: Выделить всё

Option Explicit

Private Const cmsXMLPath As String = "d:\test\calendar.xml"
Private Const cmiDuration As Long = 7 'days from today

Dim WithEvents moCalendarItems As Outlook.Items

Private Sub Application_Startup()
    Set moCalendarItems = Outlook.Session.GetDefaultFolder(olFolderCalendar).Items
    moCalendarItems.Sort "[Start]"
    moCalendarItems.IncludeRecurrences = True
    Call UpdateAppointmentXML
End Sub

Private Sub moCalendarItems_ItemAdd(ByVal Item As Object)
    Call UpdateAppointmentXML
End Sub

Private Sub moCalendarItems_ItemChange(ByVal Item As Object)
    Call UpdateAppointmentXML
End Sub

Private Sub moCalendarItems_ItemRemove()
    Call UpdateAppointmentXML
End Sub

Private Sub UpdateAppointmentXML()
   
    Dim oXMLDoc As MSXML2.DOMDocument
    Dim oRootNode As MSXML2.IXMLDOMElement
    Dim oAppointmentNode As MSXML2.IXMLDOMElement
    Dim oItems As Outlook.Items
    Dim oAppointment As Outlook.AppointmentItem
    Dim sRestrict As String
   
    Set oXMLDoc = New MSXML2.DOMDocument
    oXMLDoc.async = False
    Call oXMLDoc.appendChild(oXMLDoc.createProcessingInstruction("xml", "version=""1.0"" encoding=""UTF-8"""))
   
    Set oRootNode = oXMLDoc.appendChild(oXMLDoc.createElement("Calendar"))
    oRootNode.setAttribute "LastModified", Format(Now, "yyyy\-mm\-dd hh\:nn\:ss")
    oRootNode.setAttribute "StartDay", Format(Date, "yyyy\-mm\-dd")
    oRootNode.setAttribute "EndDay", Format(Date + cmiDuration - 1, "yyyy\-mm\-dd")
   
    sRestrict = "[End] > '" & Format(Date, "ddddd h:nn AM/PM") & "'" & _
           " And [Start] < '" & Format(Date + cmiDuration, "ddddd h:nn AM/PM") & "'" & _
           " And ([Location] = 'AQUA' Or [Location] = 'NBZ' Or [Location] = 'KBZ1' Or [Location] = 'KBZ2')"
   
    Set oItems = moCalendarItems.Restrict(sRestrict)
    For Each oAppointment In oItems
        Set oAppointmentNode = oRootNode.appendChild(oXMLDoc.createElement("Appointment"))
        With oAppointmentNode
            .setAttribute "Index", oAppointment.ConversationIndex
            .setAttribute "EntryID", oAppointment.EntryID
            .setAttribute "Start", Format(oAppointment.Start, "yyyy\-mm\-dd hh\:nn\:ss")
            .setAttribute "End", Format(oAppointment.End, "yyyy\-mm\-dd hh\:nn\:ss")
            .setAttribute "Subject", oAppointment.Subject
            .setAttribute "Location", UCase(oAppointment.Location)
            .appendChild(oXMLDoc.createElement("Body")).Text = oAppointment.Body
        End With
    Next
    oXMLDoc.Save cmsXMLPath
   
    Set oAppointment = Nothing
    Set oItems = Nothing
    Set oAppointmentNode = Nothing
    Set oRootNode = Nothing
    Set oXMLDoc = Nothing
   
End Sub

Хороший получился топик. Пообщался сам с собой.