The Code
Imports System.Runtime.InteropServices
Imports Outlook = Microsoft.Office.Interop.Outlook
Imports Microsoft.Office.Core
Imports Microsoft.Win32
Imports System.Diagnostics
Imports System.Reflection.Assembly
Imports System.Globalization
Imports System.IO
<GuidAttribute("29CC0D3D-C5E9-42e3-AFAF-E8DFED4AF2E5"), ProgIdAttribute("OutlookCOMAddinVBNET.OutAddin")> _
Public Class OutAddIn
'Module-level variables
Dim m_blnRunUnInitHandler As Boolean
'Declare CommandBarButton and CommandBarComboBox objects
Dim WithEvents CBBAbout As CommandBarButton
Dim WithEvents CBMainSendReceive As CommandBarButton
Dim WithEvents CBMainSave As CommandBarButton
'Declare event-aware object using WithEvents
Dim WithEvents m_olOutlook As Outlook.Application
Dim WithEvents m_olNamespace As Outlook.NameSpace
Dim WithEvents m_olExplorer As Outlook.ExplorerClass
Dim WithEvents m_olExplorers As Outlook.Explorers
Dim WithEvents m_olInspector As Outlook.InspectorClass
Dim WithEvents m_olInspectors As Outlook.Inspectors
Dim WithEvents m_olMailItem As Outlook.MailItemClass
Dim WithEvents m_olPostItem As Outlook.PostItem
Dim WithEvents m_olContactItem As Outlook.ContactItem
Dim WithEvents m_olDistListItem As Outlook.DistListItem
Dim WithEvents m_olAppointmentItem As Outlook.AppointmentItem
Dim WithEvents m_olTaskItem As Outlook.TaskItem
Dim WithEvents m_olJournalItem As Outlook.JournalItem
Dim WithEvents m_olDocumentItem As Outlook.DocumentItem
'These objects are OL2002 only; comment out for OL2000
Dim WithEvents m_olViews As Outlook.Views
Dim WithEvents m_olResults As Outlook.Results
Dim WithEvents m_olReminders As Outlook.Reminders
'InitHandler instantiates all event-aware objects and creates CommandBarButton
Friend Sub InitHandler(ByVal oApp As Outlook.Application, ByVal strProgID As String)
Dim oCommandBars As CommandBars
Dim oStandardBar As CommandBar
DebugWriter("InitHandler Called")
Try
'Declared WithEvents
m_olOutlook = oApp 'Application object
'Instantiate a public module-level Outlook application variable
m_olApp = oApp
'ProgID string required for CommandBarControls
m_ProgID = strProgID
'Instantiate event-aware objects
m_olNamespace = m_olOutlook.Session
m_olExplorers = m_olOutlook.Explorers
m_olInspectors = m_olOutlook.Inspectors
'Type conversion required due to "ambiguous name" issue
m_olExplorer = CType(m_olOutlook.ActiveExplorer, Outlook.ExplorerClass)
'Create command bar button
'Set up a custom button on the "Standard" command bar.
oCommandBars = m_olExplorer.CommandBars
oStandardBar = oCommandBars.Item("Standard")
' In case the button was not deleted, use the existing one.
CBBAbout = CType(oStandardBar.FindControl(Tag:="Comparto DMS"), CommandBarButton)
If CBBAbout Is Nothing Then
CBBAbout = CType(oStandardBar.Controls.Add(Type:=MsoControlType.msoControlButton, Temporary:=False), CommandBarButton)
With CBBAbout
.Caption = "Comparto DMS"
.Style = MsoButtonStyle.msoButtonIconAndCaption
.FaceId = 472
.TooltipText = "Comparto DMS"
.BeginGroup = False
' Use the Tag property to find the control
.Tag = "Comparto DMS"
.OnAction = "!<" & m_ProgID & ">"
' Make the button visible
.Visible = True
End With
End If
Catch ex As SystemException
DebugWriter("InitHandler Exception: {0}", ex.Message)
End Try
End Sub
'UnInitHandler destroys all event-aware objects
'Called in m_olExplorer_Close and m_olInspector_Close events
Friend Sub UnInitHandler()
'You must dereference all objects in this procedure
'or Outlook will remain in memory
Dim oCommandBars As CommandBars
Dim oStandardBar As CommandBar
Dim oCBB As CommandBarButton
Try
If m_blnRunUnInitHandler Then
Exit Sub
Else
m_blnRunUnInitHandler = True
End If
DebugWriter("UnInitHandler Called")
'Delete the Explorer command bar button
If Not (CBBAbout Is Nothing) Then
CBBAbout.Delete()
End If
'Delete the Inspector command bar button
CBMainSendReceiveRemove()
' Next release all Outlook objects dim'ed WithEvents
DisposeObject(m_olMailItem)
DisposeObject(m_olPostItem)
DisposeObject(m_olAppointmentItem)
DisposeObject(m_olContactItem)
DisposeObject(m_olDistListItem)
DisposeObject(m_olJournalItem)
DisposeObject(m_olTaskItem)
DisposeObject(m_olInspector)
DisposeObject(m_olExplorer)
DisposeObject(m_olInspectors)
DisposeObject(m_olExplorers)
DisposeObject(m_olReminders)
DisposeObject(m_olResults)
DisposeObject(m_olViews)
DisposeObject(m_olNamespace)
DisposeObject(m_olApp)
DisposeObject(m_olOutlook)
Catch ex As SystemException
DebugWriter("UnInitHandler Exception: {0}", ex.Message)
Finally
'Final garbage collection
GC.Collect()
GC.WaitForPendingFinalizers()
End Try
End Sub
Private Sub DisposeObject(ByVal obj As Object)
'Wraps ReleaseCOMObject to provide a 'safe' disposal helper method.
Dim count As Integer
DebugWriter("DisposeObject Called")
Try
If obj Is Nothing Then
Exit Try
End If
count = Marshal.ReleaseComObject(obj)
DebugWriter(String.Format("DisposeObject - Release {0}, RefCount: {1}", obj.ToString(), count), "")
While count > 0
count = Marshal.ReleaseComObject(obj)
End While
Catch ex As SystemException
DebugWriter("DisposeObject Exception: {0}", ex.Message)
Finally
obj = Nothing
End Try
End Sub
Private Sub m_olInspectors_NewInspector(ByVal Inspector As Outlook.Inspector) Handles m_olInspectors.NewInspector
Try
DebugWriter("NewInspector Called")
m_olInspector = CType(Inspector, Outlook.InspectorClass)
If TypeOf Inspector.CurrentItem Is Outlook.MailItem Then
'Must cast to MailItemClass due to "ambiguous name" problem
m_olMailItem = CType(Inspector.CurrentItem, Outlook.MailItemClass)
ElseIf TypeOf Inspector.CurrentItem Is Outlook.PostItem Then
m_olPostItem = CType(Inspector.CurrentItem, Outlook.PostItem)
ElseIf TypeOf Inspector.CurrentItem Is Outlook.AppointmentItem Then
m_olAppointmentItem = CType(Inspector.CurrentItem, Outlook.AppointmentItem)
ElseIf TypeOf Inspector.CurrentItem Is Outlook.ContactItem Then
m_olContactItem = CType(Inspector.CurrentItem, Outlook.ContactItem)
ElseIf TypeOf Inspector.CurrentItem Is Outlook.DistListItem Then
m_olDistListItem = CType(Inspector.CurrentItem, Outlook.DistListItem)
ElseIf TypeOf Inspector.CurrentItem Is Outlook.JournalItem Then
m_olJournalItem = CType(Inspector.CurrentItem, Outlook.JournalItem)
ElseIf TypeOf Inspector.CurrentItem Is Outlook.TaskItem Then
m_olTaskItem = CType(Inspector.CurrentItem, Outlook.TaskItem)
End If
Catch ex As SystemException
DebugWriter("NewInspector Exception: {0}", ex.Message)
End Try
End Sub
Private Sub m_olInspector_Close() Handles m_olInspector.InspectorEvents_Event_Close
Try
DebugWriter("Inspector_Close Called", "")
If m_olApp.ActiveExplorer Is Nothing And m_olApp.Inspectors.Count <= 1 Then
UnInitHandler()
End If
Catch ex As SystemException
DebugWriter("Inspector_Close Exception: {0}", ex.Message)
End Try
End Sub
Private Sub m_olExplorers_NewExplorer(ByVal Explorer As Outlook.Explorer) Handles m_olExplorers.NewExplorer
Try
DebugWriter("NewExplorer Called", "")
If m_olExplorer Is Nothing Then
m_olExplorer = CType(Explorer, Outlook.ExplorerClass)
End If
Catch ex As SystemException
DebugWriter("NewExplorer Exception: {0}", ex.Message)
End Try
End Sub
Private Sub m_olExplorer_Close() Handles m_olExplorer.ExplorerEvents_Event_Close
Try
DebugWriter("Explorer_Close Called", "")
m_olExplorer = CType(m_olApp.ActiveExplorer, Outlook.ExplorerClass)
If (m_olExplorer Is Nothing) And (m_olApp.Inspectors.Count = 0) Then
UnInitHandler()
End If
Catch ex As SystemException
DebugWriter("Explorer_Close Exception: {0}", ex.Message)
End Try
End Sub
Private Sub m_olExplorer_BeforeFolderSwitch(ByVal NewFolder As Object, ByRef Cancel As Boolean) Handles m_olExplorer.BeforeFolderSwitch
On Error Resume Next
Dim oFolder As Outlook.MAPIFolder
If NewFolder Is Nothing Then
Exit Sub
End If
'Remove if you want to instantiate these objects
'oFolder = CType(NewFolder, MAPIFolder)
'm_olViews = oFolder.Views
End Sub
Private Sub m_olOutlook_ItemSend(ByVal Item As Object, ByRef Cancel As Boolean) Handles m_olOutlook.ItemSend
On Error Resume Next
Item.UserProperties("MessageSaved").Value = True
Item.SaveAs(Item.UserProperties("MessageSaveLocn").Value, 3)
' MsgBox("Filename : " + Item.UserProperties("MessageSaveLocn").Value, MsgBoxStyle.Information, "Filename")
' MsgBox("Authorised : " + CStr(Item.UserProperties("MessageAuthorised").Value))
' MsgBox("Item Sending", MsgBoxStyle.OKOnly, "Send")
' MsgBox("Saved : " + CStr(Item.UserProperties("MessageSaved").Value))
End Sub
Private Sub m_olOutlook_NewMail() Handles m_olOutlook.NewMail
Dim cbStandard As CommandBar
Dim DoProc As Boolean
Dim oPI As Outlook.PostItem
Dim oMI As Outlook.MailItem
'Use the OutlookItem class to retrieve Item Properties
Dim MyItem As New OutlookItem(m_olMailItem)
Dim MyNewCtrl As CommandBarButton
Dim cbFile As CommandBar
Dim SendCtrl As CommandBarButton
DoProc = True
Select Case MyItem.ObjectClass
Case Outlook.OlObjectClass.olMail
oMI = CType(m_olMailItem, Outlook.MailItem)
cbStandard = oMI.GetInspector.CommandBars("Standard")
cbFile = oMI.GetInspector.CommandBars("File")
Case Outlook.OlObjectClass.olPost
oPI = CType(m_olMailItem, Outlook.PostItem)
cbStandard = oPI.GetInspector.CommandBars("Standard")
cbFile = oPI.GetInspector.CommandBars("File")
Case Else
DoProc = False
End Select
If DoProc Then
If Not m_olMailItem.UserProperties("MessageAuthorised").Value Then
If Not cbStandard Is Nothing Then
CBMainSendReceive = CType(cbStandard.FindControl(Tag:="Save and Close"), CommandBarButton)
If CBMainSendReceive Is Nothing Then
CBMainSendReceive = CType(cbStandard.Controls.Add(Type:=MsoControlType.msoControlButton, Parameter:="Save and Close"), CommandBarButton)
End If
With CBMainSendReceive
.DescriptionText = "Save and Close"
.BeginGroup = True
.Caption = "Save and Close"
.FaceId = 4211
.Tag = "Save and Close"
.TooltipText = "Save and Close"
.Style = MsoButtonStyle.msoButtonIconAndCaption
.OnAction = "!<" & m_ProgID & ">"
.Visible = True
End With
'MyNewCtrl = CType(cbStandard.FindControl(Tag:="Send"), CommandBarButton)
'MyNewCtrl.Enabled = False
'MyNewCtrl.Visible = False
'SendCtrl = CType(cbFile.FindControl(Tag:="Send"), CommandBarButton)
'SendCtrl.Visible = False
'SendCtrl.Enabled = False
End If
Else
cbStandard.Reset()
cbFile.Reset()
If m_olMailItem.UserProperties("MessageAuthorised").Value Then
If Not cbStandard Is Nothing Then
CBMainSendReceive = CType(cbStandard.FindControl(Tag:="Save and Close"), CommandBarButton)
If CBMainSendReceive Is Nothing Then
CBMainSendReceive = CType(cbStandard.Controls.Add(Type:=MsoControlType.msoControlButton, Parameter:="Save and Close"), CommandBarButton)
End If
With CBMainSendReceive
.DescriptionText = "Save and Close"
.BeginGroup = True
.Caption = "Save and Close"
.FaceId = 4211
.Tag = "Save and Close"
.TooltipText = "Save and Close"
.Style = MsoButtonStyle.msoButtonIconAndCaption
.OnAction = "!<" & m_ProgID & ">"
.Visible = True
End With
End If
End If
End If
End If
End Sub
Private Sub m_olMailItem_Close(ByRef Cancel As Boolean) Handles m_olMailItem.ItemEvents_Event_Close
MsgBox("Closing Mail Item", MsgBoxStyle.Information, "Close")
m_olMailItem.UserProperties("MessageSaved").Value = True
m_olMailItem.SaveAs(m_olMailItem.UserProperties("MessageSaveLocn").Value, 3)
' MsgBox("Filename : " + m_olMailItem.UserProperties("MessageSaveLocn").Value, MsgBoxStyle.Information, "Filename")
' Displays "ambiguous name" warning if m_olMailItem declared as MailItem
' MsgBox("Mail Item Closing", MsgBoxStyle.Information, "Closing")
End Sub
Private Sub m_olMailItem_Open(ByRef Cancel As Boolean) Handles m_olMailItem.Open
Dim cbStandard As CommandBar
Dim DoProc As Boolean
Dim oPI As Outlook.PostItem
Dim oMI As Outlook.MailItem
'Use the OutlookItem class to retrieve Item Properties
Dim MyItem As New OutlookItem(m_olMailItem)
Dim MyNewCtrl As CommandBarButton
Dim cbFile As CommandBar
Dim SendCtrl As CommandBarButton
DoProc = True
Select Case MyItem.ObjectClass
Case Outlook.OlObjectClass.olMail
oMI = CType(m_olMailItem, Outlook.MailItem)
cbStandard = oMI.GetInspector.CommandBars("Standard")
cbFile = oMI.GetInspector.CommandBars("File")
Case Outlook.OlObjectClass.olPost
oPI = CType(m_olMailItem, Outlook.PostItem)
cbStandard = oPI.GetInspector.CommandBars("Standard")
cbFile = oPI.GetInspector.CommandBars("File")
Case Else
DoProc = False
End Select
If DoProc Then
If Not m_olMailItem.UserProperties("MessageAuthorised").Value Then
If Not cbStandard Is Nothing Then
CBMainSendReceive = CType(cbStandard.FindControl(Tag:="Save and Close"), CommandBarButton)
If CBMainSendReceive Is Nothing Then
CBMainSendReceive = CType(cbStandard.Controls.Add(Type:=MsoControlType.msoControlButton, Parameter:="Save and Close"), CommandBarButton)
End If
With CBMainSendReceive
.DescriptionText = "Save and Close"
.BeginGroup = True
.Caption = "Save and Close"
.FaceId = 4211
.Tag = "Save and Close"
.TooltipText = "Save and Close"
.Style = MsoButtonStyle.msoButtonIconAndCaption
.OnAction = "!<" & m_ProgID & ">"
.Visible = True
End With
'MyNewCtrl = CType(cbStandard.FindControl(Tag:="Send"), CommandBarButton)
'MyNewCtrl.Enabled = False
'MyNewCtrl.Visible = False
'SendCtrl = CType(cbFile.FindControl(Tag:="Send"), CommandBarButton)
'SendCtrl.Visible = False
'SendCtrl.Enabled = False
End If
Else
cbStandard.Reset()
cbFile.Reset()
If m_olMailItem.UserProperties("MessageAuthorised").Value Then
If Not cbStandard Is Nothing Then
CBMainSendReceive = CType(cbStandard.FindControl(Tag:="Save and Close"), CommandBarButton)
If CBMainSendReceive Is Nothing Then
CBMainSendReceive = CType(cbStandard.Controls.Add(Type:=MsoControlType.msoControlButton, Parameter:="Save and Close"), CommandBarButton)
End If
With CBMainSendReceive
.DescriptionText = "Save and Close"
.BeginGroup = True
.Caption = "Save and Close"
.FaceId = 4211
.Tag = "Save and Close"
.TooltipText = "Save and Close"
.Style = MsoButtonStyle.msoButtonIconAndCaption
.OnAction = "!<" & m_ProgID & ">"
.Visible = True
End With
End If
End If
End If
End If
End Sub
Private Sub m_olMailItem_Send(ByRef Cancel As Boolean) Handles m_olMailItem.ItemEvents_Event_Send
On Error Resume Next
m_olMailItem.UserProperties("MessageSaved").Value = True
m_olMailItem.SaveAs(m_olMailItem.UserProperties("MessageSaveLocn").Value, 3)
End Sub
Private Sub CBMainSendReceive_Click(ByVal Ctrl As Microsoft.Office.Core.CommandBarButton, ByRef CancelDefault As Boolean) Handles CBMainSendReceive.Click
m_olMailItem.UserProperties("MessageSaved").Value = True
m_olMailItem.SaveAs(m_olMailItem.UserProperties("MessageSaveLocn").Value, 3)
m_olMailItem.Close(Outlook.OlInspectorClose.olDiscard)
' MsgBox("This option has not been enabled yet!", MsgBoxStyle.Critical, "Not Enabled")
End Sub
End Class
