This VBA code will make Outlook select a random task from you to-do list, and then based on your feedback give you positive or negative reinforcements. In this case, if you do the task it shows a simple message and marks the task as complete, while not doing it displays a random post from Fail Blog. It was tested with Outlook 2010, but should work with any Outlook version that supports RSS feeds.
Please note that I will not be held responsible for any loss of productivity as a result of navigating Fail Blog!
'Generic stuff necessary for Outlook Macros.
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
'Selects incomplete tasks from your default tasks folder
Set objFolder = objNamespace.GetDefaultFolder(olFolderTasks)
Set colItems = objFolder.Items
strFilter = "[Complete] = FALSE"
Set coltasks = colItems.Restrict(strFilter)
'Selects posts from an RSS Feed to display when a task is not completed.
'Note: You have to previously add the RSS Feed to your Outlook.
Set objFolder2 = objNamespace.Folders.Item("Personal Folders")
Set objFolder1 = objFolder2.Folders.Item("RSS Feeds")
Set objFail = objFolder1.Folders.Item("FAIL Blog: Epic Fail Funny Pictures and Funny Videos of Owned, Pwned and Fail Moments")
Set FailPosts = objFail.Items
Dim n As Integer
Dim f As Integer
'Picks a random task for the user, and asks for feedback on task completion
n = Int((coltasks.count) * Rnd + 1)
Answer = MsgBox("Do this task: " & coltasks(n).Subject & vbCrLf & vbCrLf & "RIGHT NOW!", vbQuestion + vbYesNo, "???")
If Answer = vbNo Then
'Code for No
f = Int((FailPosts.count) * Rnd + 1)
MsgBox "EPIC FAIL!"
'Code for Yes
MsgBox "You are my hero!"
This feature was inspired by