Sep 13 2011 at 20:17

SMS оповещение в Microsoft Outlook

Invite pending

Я занимаюсь разработкой и поддержкой проектов, в мои обязанности входит быстрое реагирование на некоторый тип входящей почты. Взаимодействие осуществляется средствами Microsoft Exchange, поэтому в наборе программного обеспечения почтовый клиент Outlook и все вытекающие удобства или не удобства.

С перемещением корреспонденции по папкам средствами фильтров вопросов не возникло, но как быть с удаленным оповещением — если меня нет на рабочем месте?

Держать постоянный онлайн смартфона от которого будет разряжаться батарея в считанные часы — это не для меня, да и я несилен в написании программ под мобильные устройства. На мой взгляд самый оптимальный вариант — sms оповещение. Начал изучать данный вопрос — в итоге два варианта отправки sms.

1 — купить подписку на подходящий по тарифам сервис отправки смс

Настройки для сервиса Tools > Options...

Затем создать фильтр с использованием правила оповещения на мобильный.

Но это не для меня, мой мобильный оператор предоставляет услугу благодаря которой я могу осуществить простой бесплатный способ оповещения.

2 — отправка почтового сообщение на ваш номер через шлюз оператора

(при условии поддержки такого сервиса вашим мобильным оператором)

Отправку сообщения будем выполнять через VBA макрос — открываем редактор макросов Alt-F11,

в дереве проекта создаем класс Support и копируем в него следующий код:

Option Explicit

' Settings
Public NotificationTo As String
Public PrimeTimeBegin As Integer
Public PrimeTimeEnd As Integer

' Send SMS  message
Public Sub Notification(Subject As String)

    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon

    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = NotificationTo
        .CC = ""
        .BCC = ""
        .Subject = Subject
        .Body = Now
        .Send
        .ReadReceiptRequested = True
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

' Is prime time?
Public Function IsPrimeTime()

    Dim hh As Integer

    IsPrimeTime = False

    hh = hour(Now)
    If hh >= PrimeTimeBegin And hh < PrimeTimeEnd Then
        IsPrimeTime = True
    End If

End Function

Дальше в дереве проекта выбираем ThisOutlookSession и добавляем в нее процедуру с параметром типа Outlook.MailItem.

Sub Alarm(Item As Outlook.MailItem)

    Dim AI As New support
    With AI
        .NotificationTo = "@"            ' email вашего моб. номера
        .PrimeTimeBegin = 10           ' временные рамки оповещения
        .PrimeTimeEnd = 19              '
    End With

    If AI.IsPrimeTime = True Then
        AI.Notification (CStr(Item.Subject))
    End If
    
End Sub

Последний шаг: настраиваем фильтр с действием «run a script» и выбираем нашу процедуру, а также настройки безопасности.

Пока что я не вникал в подробности подписи макросов, поэтому пришлось отключить проверку, иначе Outlook будет выдавать popup окно с подтверждением и наш триггер не будет срабатывать без клика по кнопке.

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

Tags:

Hubs:

Lumber room