Scripting in Outlook – Stuck Draft messages.

My buddy Jeff Miller sent over this crafty Outlook script that he thought someone might find useful.  Here it is with some background on why he wrote it.

I had a user complain about 500+ emails for an email distribution stuck in her outbox.  My current environment is Outlook 2010 and Exchange 2007.  I couldn’t figure out the reason for why they were stuck so I went down the basic troubleshooting steps.

  • Opening one of them and clicking send – did not help
  • Closing outlook and reopening – did not help
  • Clicking on send/receive – did not help
  • Moving the messages to another folder and dropping them back in outbox – did not help
  • Setting outlook to offline mode and then going back online  – did not help
  • Recreated outlook profile on that users computer  – did not help
  • Opened the mailbox as my blackberry admin on another computer  – did not help
  • I even gave up and rebooted the users computer  – did not help

After searching Microsoft forums, I did find that this is a common issue and some say the steps above helped them out, and others said it didn’t.  I found a post where someone mentioned putting them into the drafts folder and opening the email and clicking send.  This solution did work for me  but there was no way that I was going to do this 500+ times, and I am sure my user wouldn’t either.  I quickly searched and found a post on how to write a script to email all items in the drafts folder which turned out successful for me.

Link #1 & Link #2

It took me a minute to figure out the parent folder name, so I commented that explanation into the

  1. Start Outlook and choose Tools, Macro, Visual Basic Editor (or press Alt+F11) to open the VBA Editor.
  2. In the Project window, select Project1 and expand the tree until you see ThisOutlookSession.
  3. Select ThisOutlookSession and press F7 to open the Code window.
  4. Enter the following in the Code window:.

Public Sub SendDrafts()
Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder
'Send all items in the "Drafts" folder that have a "To" address filled in.
'Setup Outlook
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders
'Set Draft Folder.
The name of the parent folder is the line directly above your inbox in outlook, in this case it was the users email
Set myDraftsFolder = myFolders("put name of the parent folder of your draft folder in here").Folders("Drafts")
'Loop through all Draft Items
For lDraftItem = myDraftsFolder.Items.Count To 1 Step 1
'Check for "To" address and only send if "To" is filled in.
If Len(Trim(myDraftsFolder.Items.Item(lDraftItem).To)) > 0 Then
'Send Item
End If
Next lDraftItem
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing
End Sub