Outlook 通知腳本 PushBullet Ver 1.0

使用PushBullet 寄發 outlook 信件通知
有時候公司信 外部不能收 , 亦或是作業環境關係不能時常檢查信件,

當收到新信件時,透過PushBullet 只將標題和寄件者提醒至手機上
更換 YOUR_ACCESS_TOKEN 

取得方式請到 https://www.pushbullet.com/ > setting 取得API TOKEN
可以指定哪一個device 要接受此通知,帶入ID即可

' PushBullet  MARCO 腳本 Ver 1.0 by henry

' PushBullet  YOUR_ACCESS_TOKEN

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

    Dim objItem

    Set objItem = Session.GetItemFromID(EntryIDCollection)

    If objItem.MessageClass = "IPM.Note" Then

        AutoForward objItem

    End If

End Sub







Private Sub AutoForward(ByVal objMail As MailItem)

    '

    Dim strFileName As String

    Dim fwMail As MailItem

'   Dim i As Integer

    Dim strSenderName As String

    Dim strSenderEmailAddress As String

    Dim strSubject As String

    Dim strbody As String

'

    On Error GoTo ErrorTrap

    '

    ' 標題、送信者、本文取得

    strSubject = objMail.Subject    ' 標題取得

    strSenderName = objMail.SenderName  ' 送信者取得

    strSenderEmailAddress = objMail.SenderEmailAddress  ' Email取得

    strbody = objMail.Body ' 本文取得

 strbody = mid(strbody,0,100)

    '



    If strSenderName = strSenderEmailAddress Then

        strSenderName = strSenderEmailAddress



    Else

        If InStr(strSenderEmailAddress, "@") Then

            strSenderName = strSenderName + "<" + strSenderEmailAddress + ">"

        Else

            strSenderEmailAddress = _

            objMail.Sender.PropertyAccessor.GetProperty("http://schemas." _

            & "microsoft.com/mapi/proptag/0x39FE001E")

            strSenderName = strSenderName + "<" + strSenderEmailAddress + ">"

        End If

    End If

    '







 TargetURL = "https://api.pushbullet.com/v2/pushes"

  Set HTTPReq = CreateObject("WinHttp.WinHttpRequest.5.1")

  HTTPReq.Option(4) = 13056 '

  HTTPReq.Open "POST", TargetURL, False

  HTTPReq.SetCredentials "user", "password", 0







  HTTPReq.setRequestHeader "Authorization", "Bearer YOUR_ACCESS_TOKEN"

  HTTPReq.setRequestHeader "Content-Type", "application/json"







  Message = "{""type"": ""note"", ""title"": " & _

      vbDoubleQuote & strSubject & vbDoubleQuote & ", ""body"": " & _

      vbDoubleQuote & strbody & vbDoubleQuote & "}"

  HTTPReq.Send (Message)







  ' delete this line once you are happy it works. Or put in some proper error handling!

  MsgBox (HTTPReq.responseText)







'

ErrorTrap:

'

End Sub