Read RSS Later - Microsoft Outlook 2007 macro

Read RSS Later is Microsoft Outlook 2007 macro which allows to add articles from Outlook's RSS feeds to Read It Later service. Full article is added (what you see if click on View article... link in the RSS message). Addition of multiple articles at the same time is possible.

Do the following to add macro to your Outlook 2007:

1. Start MS Outlook 2007;
2. Open Visual Basic Editor - press Alt+F11, when Outlook is active OR choose menu Tools - Macro - Visual Basic Editor;
3. Choose ThisOutlookSession on the left:
   
4. Copy and paste the code below to the right window:
   
   
   1. Private Const CP_UTF8 = 65001
   2. Private Declare Function WideCharToMultiByte Lib "Kernel32" (ByVal CodePage As Long, ByVal dwflags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long
   3.  
   4. Sub Application_ItemContextMenuDisplay( _
   5.   ByVal CommandBar As Office.CommandBar, _
   6.   ByVal Selection As Selection)
   7.   
   8.   Dim objButton As Office.CommandBarButton
   9.   
   10.   On Error GoTo ErrRoutine
   11.   
   12.   ' Available only if first selected item is RSS
   13.   If (Selection.Item(1).MessageClass = "IPM.Post.Rss") Then
   14.     ' Add a new button to the bottom of the CommandBar
   15.     ' (which represents the item context menu.)
   16.     Set objButton = CommandBar.Controls.Add( _
   17.       msoControlButton)
   18.     
   19.     ' Configure the button to call the
   20.     ' ReadRSSLater routine when
   21.     ' clicked. The Parameter property of the
   22.     ' button is set to the value of the
   23.     ' EntryID property for the selected
   24.     ' item, if possible.
   25.     With objButton
   26.       .BeginGroup = True
   27.       .Caption = "Read RSS &Later"
   28.       .FaceId = 1000
   29.       .Tag = "ReadRSSLater"
   30.       If Not IsNull(Selection.Item(1)) Then
   31.         On Error GoTo 0
   32.         ' Just in case the item selected
   33.         ' doesn't have a valid EntryID.
   34.         ' .Parameter = Selection.Item(1).EntryID
   35.         On Error GoTo ErrRoutine
   36.       End If
   37.       .OnAction = _
   38.         "Project1.ThisOutlookSession.ReadRSSLater"
   39.     End With
   40.   End If
   41.   
   42. EndRoutine:
   43.   Exit Sub
   44.   
   45. ErrRoutine:
   46.   MsgBox Err.Number & " - " & Err.Description, _
   47.     vbOKOnly Or vbCritical, _
   48.     "Application_ItemContextMenuDisplay"
   49.   GoTo EndRoutine
   50. End Sub
   51.  
   52. Private Sub ReadRSSLater()
   53.   Const RIL_USERNAME = "YOUR_RIL_USERNAME"
   54.   Const RIL_PASSWORD = "YOUR_RIL_PASSWORD"
   55.     
   56.   Const RIL_APPKEY = "377p2o2aA7c0Zw76d1g17a9ca9d6nx3f"
   57.   Const RIL_ADDURL = "https://readitlaterlist.com/v2/add"
   58.   
   59.  
   60.   Dim objNamespace As NameSpace
   61.   Dim objItem As Object
   62.   Dim strResult As String
   63.   Dim iCountOK As Integer
   64.   Dim iCountError As Integer
   65.   
   66.   On Error GoTo ErrRoutine
   67.   
   68.   iCountOK = 0
   69.   iCountError = 0
   70.   
   71.   For Each objItem In Application.ActiveExplorer.Selection
   72.      
   73.     If (objItem.MessageClass = "IPM.Post.Rss") Then
   74.     
   75.       If objItem Is Nothing Then
   76.         MsgBox "A reference for the Outlook item " & _
   77.           "could not be retrieved."
   78.       Else
   79.         Dim RssURL As String
   80.         RssURL = objItem.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/id/{00062041-0000-0000-C000-000000000046}/8901001F")
   81.         ' https://readitlaterlist.com/v2/add?username=name&password=123&apikey=yourapikey&url=http://google.com&title=Google
   82.         Dim AddURL As String
   83.         AddURL = RIL_ADDURL + _
   84.              "?username=" + RIL_USERNAME + _
   85.              "&password=" + RIL_PASSWORD + _
   86.              "&apikey=" + RIL_APPKEY + _
   87.              "&url=" + URLEncode(RssURL) + _
   88.              "&title=" + URLEncode(objItem.Subject)
   89.         ' Debug.Print AddURL
   90.         
   91.         Dim WinHttpReq As Object
   92.         Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
   93.         WinHttpReq.Open "GET", AddURL, False
   94.         WinHttpReq.Send
   95.         If WinHttpReq.Status = 200 Then
   96.           iCountOK = iCountOK + 1
   97.         Else
   98.           iCountError = iCountError + 1
   99.           strResult = strResult & objItem.Subject & ": " & WinHttpReq.ResponseText & _
   100.                 vbCrLf & vbCrLf
   101.         End If
   102.         ' Debug.Print objItem.Subject & ": " & WinHttpReq.ResponseText & "; " & WinHttpReq.ResponseText
   103.       End If
   104.     End If
   105.   Next objItem
   106.   strResult = "Errors: " & iCountError & ", OK: " & iCountOK & vbCrLf & vbCrLf & strResult
   107.   MsgBox strResult, vbOKOnly, "Read RSS Later"
   108.  
   109. EndRoutine:
   110.   Set objItem = Nothing
   111.   Set objNamespace = Nothing
   112.   Exit Sub
   113.  
   114. ErrRoutine:
   115.   MsgBox Err.Number & " - " & Err.Description, _
   116.     vbOKOnly Or vbCritical, _
   117.     "Read RSS Later"
   118.   GoTo EndRoutine
   119. End Sub
   120.  
   121.  
   122. Public Function UTF16To8(ByVal UTF16 As String) As String
   123. Dim sBuffer As String
   124. Dim lLength As Long
   125. If UTF16 <> "" Then
   126.   lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(UTF16), -1, 0, 0, 0, 0)
   127.   sBuffer = Space$(lLength)
   128.   lLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(UTF16), -1, StrPtr(sBuffer), Len(sBuffer), 0, 0)
   129.   sBuffer = StrConv(sBuffer, vbUnicode)
   130.   UTF16To8 = Left$(sBuffer, lLength - 1)
   131. Else
   132.   UTF16To8 = ""
   133. End If
   134. End Function
   135.  
   136. Public Function URLEncode( _
   137.   StringVal As String, _
   138.   Optional SpaceAsPlus As Boolean = False, _
   139.   Optional UTF8Encode As Boolean = True _
   140. ) As String
   141.  
   142. Dim StringValCopy As String: StringValCopy = IIf(UTF8Encode, UTF16To8(StringVal), StringVal)
   143. Dim StringLen As Long: StringLen = Len(StringValCopy)
   144.  
   145. If StringLen > 0 Then
   146.   ReDim Result(StringLen) As String
   147.   Dim I As Long, CharCode As Integer
   148.   Dim Char As String, Space As String
   149.  
   150.  If SpaceAsPlus Then Space = "+" Else Space = "%20"
   151.  
   152.  For I = 1 To StringLen
   153.   Char = Mid$(StringValCopy, I, 1)
   154.   CharCode = Asc(Char)
   155.   Select Case CharCode
   156.    Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
   157.     Result(I) = Char
   158.    Case 32
   159.     Result(I) = Space
   160.    Case 0 To 15
   161.     Result(I) = "%0" & Hex(CharCode)
   162.    Case Else
   163.     Result(I) = "%" & Hex(CharCode)
   164.   End Select
   165.  Next I
   166.  URLEncode = Join(Result, "")
   167.  
   168. End If
   169. End Function
   170.  
   * This source code was highlighted with Source Code Highlighter.
   
5. Replace in the code YOUR_RIL_USERNAME and YOUR_RIL_PASSWORD (lines 53 and 54) with your Read It Later username and password accordingly; 
6. Save the change (Ctrl+S). 

New context menu item (Read RSS Later) will be added to RSS articles in your Outlook 2007: