Public Sub StripAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolder As String

' Get the Temp folder.
strFolder = GetTempDir()
If strFolder = "" Then
MsgBox "Could not get Temp folder", vbOKOnly
GoTo ExitSub
End If

' Check each selected item for attachments.
' If attachments exist, save them to the Temp
' folder and strip them from the item.
For Each objMsg In objSelection
' This code only strips attachments from mail items.
If objMsg.Class = olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
If lngCount > 0 Then
' We need to use a count down loop for
' removing items from a collection. Otherwise,
' the loop counter gets confused and only every
' other item is removed.
For i = lngCount To 1 Step -1
' Save attachment before deleting from item.
' Get the file name.
strFile = objAttachments.Item(i).FileName
' Combine with the path to the Temp folder.
strFile = strFolder & strFile
' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strFile
' Delete the attachment.
objAttachments.Item(i).Delete
Next i
End If
objMsg.Save
End If
Next

If Err Then
GetTempDir = ""
Else
GetTempDir = LCase(tFolder.Path)
' Add "\" to the rightmost part of the path to
' the Temp folder if necessary.
If Right$(GetTempDir, 1) <> "\" Then
GetTempDir = GetTempDir & "\"
End If
End If

Send and receive in Outlook 2000 Corporate or Workgroup
mode or Outlook 2002. This code will cause an error in Outlook 2000 Internet
Only mode. It will also cause a security prompt in Outlook 2000 SP2 or Outlook
2002.

Public Sub SendReceiveNowCorpMode()
'Only works in Corporate/Workgroup mode
'Requires a project reference to CDO 1.21 (CDO.DLL)
Dim objCDO As MAPI.Session

'First find and send the current item to the Outbox
Set objItem = objOutlook.ActiveInspector.CurrentItem
objItem.Send

'Then use the Send/Receive on All Accounts action in the Tools
'menu to send the item from the Outbox, and receive new items
Set objCB = objOutlook.ActiveExplorer.CommandBars("Menu Bar")
Set objPop = objCB.Controls("Tools")
Set objPop = objPop.Controls("Send/Receive")
Set objCtl = objPop.Controls("All Accounts")
objCtl.Execute

'First find and send the current item to the Outbox
Set objItem = objOutlook.ActiveInspector.CurrentItem
objItem.Send

'Then use the Send action in the Tools menu
'to send the item from the Outbox
Set objCB = objOutlook.ActiveExplorer.CommandBars("Menu Bar")
Set objPop = objCB.Controls("Tools")
Set objCtl = objPop.Controls("Send")
objCtl.Execute

The Internet headers are only present in emails
received from POP3 emails. They are not present in emails sent over Microsoft
Exchange server. This function returns the Internet headers as a string value.

'Find the current email item and get its EntryID
Set objItem = objOutlook.ActiveInspector.CurrentItem
strID = objItem.EntryID

'Then set up a CDO Session using a piggy-back login
Set objCDO = CreateObject("MAPI.Session")
objCDO.Logon "", "", False, False

'Now get the item as a CDO Message
Set objMessage = objCDO.GetMessage(strID)

'Now get the headers from the message
Set objFields = objMessage.Fields
InternetHeaders = objFields.Item(CdoPR_TRANSPORT_MESSAGE_HEADERS).Value
'Now that the headers are captured in a string you can do
whatever you want with them

'Create the disclaimer string.
strDisclaimer = "The information contained in this message " _
& "constitutes privileged and confidential information " _
& "and is intended only for the use of and review by " _
& "the recipient designated above."
'Add a blank line between the email text and the disclaimer.
strDisclaimer = vbCrLf & strDisclaimer

Set objOutlook = CreateObject("Outlook.Application")

'The ActiveInspector is the currently open item.
Set objInspector = objOutlook.ActiveInspector

'Check and see if anything is open.
If Not objInspector Is Nothing Then
'See if the current item is an e-mail item.
If objInspector.CurrentItem.Class = olMail Then
'Get the current mail item.
Set objMail = objInspector.CurrentItem
'Add the disclaimer to the end of the e-mail.
objMail.Body = objMail.Body & strDisclaimer
Else
'Show error message with only the OK button.
MsgBox "This is not an e-mail item"
End If
Else
'Show error message with only the OK button.
MsgBox "No item is open"
End If

MacroExit:
'Set all objects equal to Nothing to destroy them and
'release the memory and resources they take.
Set objOutlook = Nothing
Set objInspector = Nothing
Set objMail = Nothing

'************************************************************
' This code is in the class module where the init code is
' placed and where the NewInspector event is handled. The
' class module should declare an Inspectors collection using
' the WithEvents statement and then set up a NewInspector
' event handler.
'************************************************************

'g_olApp is a global Outlook.Application object that is derived
' from the Application object passed to the COM addin in the
' On_Connection event.
If g_olApp.Explorers.Count = 0 And g_olApp.Inspectors.Count <= 1 Then
Set objInsp = Nothing
'call the code to release all Outlook objects
UnInitHandler
End If
End Sub

'************************************************************
' This code is in a code module called basOutlInsp. The
' wrapper class for an Inspector is called clsInspWrap.
' The collection that holds the Inspector wrapper
' classes is called g_colInspWrap. It is declared in a
' code module as a global Collection object.
'************************************************************

Public g_colInspWrap As New Collection

Private intID As Integer
Private blnActivate As Boolean

Public Function AddInsp(Inspector As Outlook.Inspector) As String
Dim objInspWrap As New clsInspWrap
Dim objItem As Object
Dim strID As String

On Error Resume Next

'set the Inspector in the class
objInspWrap.Inspector = Inspector

Set objItem = Inspector.CurrentItem
'test which Outlook item type is here
Select Case objItem.Class
Case olMail
'we are handling events for this item type,
' so add a new class to the collection and
' set up the item in the Inspector so events
' for the item can be handled.
objInspWrap.MailItem = objItem
Case olContact
objInspWrap.ContactItem = objItem
Case Else
End Select

Public Sub KillInsp(intID As Integer, objInspWrap As clsInspWrap)
Dim objInspWrap2 As clsInspWrap

On Error Resume Next

Set objInspWrap2 = g_colInspWrap.Item(CStr(intID))
' check to make sure we're removing the
' correct Inspector from the collection.
If Not objInspWrap2 Is objInspWrap Then
Err.Raise 1, Description:="Unexpected Error in KillInsp"
GoTo ExitSub
End If

g_colInspWrap.Remove CStr(intID)

ExitSub:
Set objInspWrap2 = Nothing
End Sub

'************************************************************
' This code is in the class module used as an Inspector
' wrapper. One instance of this class is added to a
' collection each time a new Inspector is opened and
' the instance is removed from the collection when the
' Inspector closed. The class is called clsInspWrap.
'************************************************************

Set oControl = m_obj.CommandBars.FindControl(Tag:=mnuTag)
If Not oControl Is Nothing Then
oControl.Delete
End If

Set oControl = Nothing
End Sub

Private Sub CreateButtons(objInspector As Outlook.Inspector)
On Error Resume Next

'Adding a new menu item and a button to the main menu for any Inspector
' must take a different approach if using Word as email editor.
If (objInspector.IsWordMail = True) And _
(objInspector.EditorType = olEditorWord) Then

'See if the property for the Exchange version is there.
'It won't be there if running in Outlook 2003 cached mode,
' offline mode or no Exchange is being used.
If Not (IsEmpty(rdmFolder.Fields(PR_REPLICA_VERSION))) Then
'Get the server version for the
folder.
ExchangeValue =
rdmFolder.Fields(PR_REPLICA_VERSION)