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?”
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.
2. Whilst in Outlook select File > Options > Trust Center > Trust Center Settings > Macro Settings > Seelct “Enable all macros…” > Tick “Apply macro security…” > OK.
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

