Outlook 2013 and 2010 Stop – Do you want to send this message without a subject?

KB ID 0000371 

Problem

With Outlook 2010, everytime you send and email withough a subject line you get the following prompt

Do you want to send this message without a subject?

“Do you want to send this message without a subject?”

 

Now there are sensible reasons for this, but a lot of the time I don’t really want to put in a subject, especially if I’m conversing with friends colleagues etc. And I’m really sick and tired of being asked.

Solution

1. Open Outlook, Press ALT+F11 > Expand Project1 > Microsoft Outlook Object > This Outlook Session (Note: if you can’t see the code window right click and select “View Code” > Paste in the script (see below) > Click Save > Close the VBA project window to return to Outlook.

stop outlook asking

2. Whilst in Outlook select File > Options > Trust Center > Trust Center Settings > Macro Settings > Seelct “Enable all macros…” > Tick “Apply macro security…” > OK.

Outlook Macro Settings

3. Restart Outlook

The Script (Note: I DID NOT WRITE THIS the good folk here did).

Option Explicit

'=========================================================================
' Prevents Outlook® 2010 to display a no-subject warning message
' (c) Peter Marchert - http://www.outlook-stuff.com
' 2010-07-15 Version 1.0.0
' 2010-07-19 Version 1.0.1
' 2010-08-01 Version 1.1.0
' 2010-08-31 Version 1.1.1
'=========================================================================

Private WithEvents colInspectors As Outlook.Inspectors

Private Sub Application_Startup()

    '---------------------------------------------------------------------
    ' Set a reference to all forms
    '---------------------------------------------------------------------
    Set colInspectors = Outlook.Inspectors

End Sub

Private Sub colInspectors_NewInspector(ByVal Inspector As Inspector)

    '---------------------------------------------------------------------
    ' This code is running if a form (e. g. an e-mail) will be opened
    '---------------------------------------------------------------------

    Dim objItem As Object

    '---------------------------------------------------------------------
    ' Skip errors
    '---------------------------------------------------------------------
    On Error GoTo ExitProc

    '---------------------------------------------------------------------
    ' Set a reference to the open item
    '---------------------------------------------------------------------
    Set objItem = Inspector.CurrentItem

    '---------------------------------------------------------------------
    ' Skip appointments, not meeting items
    '---------------------------------------------------------------------
    If InStr(LCase(objItem.MessageClass), "ipm.appointment") > 0 Then
        If objItem.MeetingStatus = 0 Then GoTo ExitProc
    End If

    '---------------------------------------------------------------------
    ' A new item does not have an ID
    '---------------------------------------------------------------------
    If objItem.EntryID = "" Then

        '-----------------------------------------------------------------
        ' Check if the subject is empty if an item was created by a
        ' template with predefined subject.
        '-----------------------------------------------------------------
        If objItem.Subject = "" Then objItem.Subject = " "

        '-----------------------------------------------------------------
        ' Meeting items will be checked for a empty location too
        '-----------------------------------------------------------------
        If objItem.Location = "" Then objItem.Location = " "

    End If

ExitProc:

    '---------------------------------------------------------------------
    ' Delete the reference to the form and to the item
    '---------------------------------------------------------------------
    Set objItem = Nothing
    Set Inspector = Nothing

End Sub

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    On Error Resume Next

    '---------------------------------------------------------------------
    ' If a blank still exists it will now be removed (Outlook®
    ' will this not recognize)
    '---------------------------------------------------------------------
    Item.Subject = Trim(Item.Subject)
    Item.Location = Trim(Item.Location)

End Sub

Private Sub Application_Quit()

    '---------------------------------------------------------------------
    ' Delete the reference to the forms
    '---------------------------------------------------------------------
    Set colInspectors = Nothing

End Sub

 

Related Articles, References, Credits, or External Links

NA

 

Author: Migrated

Share This Post On