Создание event c SMS уведомлением в Google Calendar с использованием XMLHTTP и запуск скрипта из Outlook

    Создание event:


    1. Для начала необходимо настроить ваш Google Calendar — вот здесь описано как это сделать

    2. Сохранить VBScript код в vbs-файле (например, google_sms.vbs).

    3. Строка запуска:
    cscript.exe google_sms.vbs «Google account name» «Google account pass» «Path to text file»

    Интеграция в Outlook:


    1. Открыть «Tools»-«Macro»-«Visual Basic Editor», выбрать ThisOutlookSession в проекте VbaProject.OTM. Вставить SendNotificationSMS функцию. Необходимо указать: User, Password, Путь к скрипту.

    Желательно «подписать» скрипт (в Visual Basic Editor «Tools»-«Digital Signature...»)

    2. Создать правило «Tools»-«Rules and Alerts…» и выбрать «run a script» действие. Выбрать функцию SendNotificationSMS.

    3.Outlook 2007. Открыть «Tools»-«Macro»-«Security…». Установить “Warning for all macros”. Перезапустить Outlook. Если появится окошко с «Enable Disable macros» то сделать Enable (обычно появляется при первом срабатывании правила или открытии «Tools»-«Macro»-«Visual Basic Editor»)

    4. Проверить что все работает – отправив например самому себе e-mail, правило на которое должно вызывать .


    google_sms.vbs:
    email = WScript.Arguments(0) 
    passwd = WScript.Arguments(1) 
    FileName = WScript.Arguments(2) 
    ReminderMinutes = 10
    DelayMinutes = 2
    EventMinutes = 10
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpenTextFile(FileName, 1, False)
    text = ts.ReadAll		
    ts.Close
    text = Replace(text, vbCr, " ") 
    text = Replace(text, vbLf, " ") 
    text = Replace(text, vbCrLf, " ") 
    text = Replace(text, ":", "-")
    
    BeginEntry = "<entry xmlns='http://www.w3.org/2005/Atom' xmlns:gCal='http://schemas.google.com/gCal/2005'><content type=""html"">" 
    ContentEntry = "</content><gCal:quickadd value=""true""/>"
    EndEntry = "</entry>"
    ReminderEntry ="<gd:reminder minutes='" + ReminderMinutes + "' method='sms'/>"
    
    authUrl = "https://www.google.com/accounts/ClientLogin" 
    calendarUrl = "http://www.google.com/calendar/feeds/default/private/full" 
    
    Set objHTTP = CreateObject("Microsoft.XMLHTTP") 
    objHTTP.open "POST", authUrl, FALSE 
    
    objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" 
    objHTTP.send "Email=" + email + "&Passwd=" + passwd + "&service=cl&source=Gulp-CalGulp-1.05" 
    'WScript.Echo objHTTP.status 
    'WScript.Echo "Headers:" + objHTTP.getAllResponseHeaders() 
    
    strAuthTokens = objHTTP.responseText 
    strAuthTokens = Replace(strAuthTokens, vbCr, "") 
    strAuthTokens = Replace(strAuthTokens, vbLf, "") 
    strAuthTokens = Replace(strAuthTokens, vbCrLf, "") 
    strAuthTokens = Replace(strAuthTokens, "SID", "&SID", 1, 1) 
    strAuthTokens = Replace(strAuthTokens, "LSID", "&LSID") 
    strAuthTokens = Replace(strAuthTokens, "Auth", "&Auth") 
    
    'WScript.Echo strAuthTokens 
    strAuthTokens = Right(strAuthTokens, Len(strAuthTokens)-Len("Auth=")-InStr(strAuthTokens, "Auth=")+1) 
    'WScript.Echo strAuthTokens 
    
    Set objHTTP = Nothing 
    
    Set objHTTP = CreateObject("Microsoft.XMLHTTP") 
    objHTTP.open "POST", calendarUrl, FALSE 
    objHTTP.setRequestHeader "Content-Type", "application/atom+xml" 
    objHTTP.setRequestHeader "Authorization", "GoogleLogin auth=" & strAuthTokens
    
    calendarEntry = "<entry xmlns='http://www.w3.org/2005/Atom'" _ 
    & " xmlns:gd='http://schemas.google.com/g/2005'>" _ 
    & "<category scheme='http://schemas.google.com/g/2005#kind'" _ 
    & " term='http://schemas.google.com/g/2005#event'></category>" _ 
    & "<title type='text'>" & "SMS" & "</title>" _ 
    & "<content type='text'></content>" _ 
    & "<gd:transparency" _ 
    & " value='http://schemas.google.com/g/2005#event.opaque'>" _ 
    & "</gd:transparency>" _ 
    & "<gd:eventStatus" _ 
    & " value='http://schemas.google.com/g/2005#event.confirmed'>" _ 
    & "</gd:eventStatus>" _ 
    & "<gd:where valueString='" & text & "'></gd:where>" _ 
    
    dt = DateAdd( "n", ReminderMinutes + DelayMinutes, Now)
    objHTTP.send calendarEntry & "<gd:when startTime=" & GetDateTime(dt) & " endTime=" & GetDateTime(DateAdd("n", EventMinutes, dt)) & ">" & ReminderEntry & "</gd:when>" & EndEntry
    'WScript.Echo  objHTTP.status 
    'WScript.Echo "Headers:" + objHTTP.getAllResponseHeaders() 
    
    strResponse = objHTTP.responseText 
    
    'WScript.Echo strResponse
    
    Function PadZero(value)  
       PadZero = String(2 - Len(value), "0") &  value		    
    End Function	
    
    Function GetDateTime(value)  
       GetDateTime = "'" & Year(value) & "-" & PadZero(Month(value)) & "-" & PadZero(Day(value)) & "T" & PadZero(Hour(value)) & ":" & PadZero(Minute(value)) & ":" & PadZero(Second(value)) & "'"	   
    End Function
    




    Visual Basic Editor в Outlook:
     Sub SendNotificationSMS(MyMail As MailItem)
        User = ""
        Password = ""
        Text = MyMail.Body
            
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set WshShell = CreateObject("WScript.Shell")
        
        Const TemporaryFolder = 2
        TempFolder = fso.GetSpecialFolder(TemporaryFolder)
        TempFile = TempFolder & "\" & fso.GetTempName()
            
        Set ts = fso.OpenTextFile(TempFile, 2, True)
        ts.Write (Text)
        ts.Close
        
        WshShell.Run "cscript.exe " & "C:\temp\google_sms.vbs" & " " & User & " " & Password & " " & TempFile, 2, True
        
        fso.DeleteFile (TempFile)
    
    End Sub
    


    Похожие публикации

    AdBlock похитил этот баннер, но баннеры не зубы — отрастут

    Подробнее
    Реклама

    Комментарии 5

      0
      хорошо бы засунуть под хабракат.
        0
        В строке
        ReminderEntry ="<gd:reminder minutes='" + ReminderMinutes + "' method='sms'/>"

        нужно заменить
        ReminderMinutes

        на
        CStr(ReminderMinutes)


        СПАСИБО! все гениальное просто! =)
          0
          CStr необязательно — число переобразуется в строчку автоматически при конкатенации
            0
            Вполне допускаю, что у Вас все работает, но мой 2007 аутлук ругнулся и попросил исправить)
          0
          Заголовок тянет на тему для дипломного проекта =)

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

          Самое читаемое