'******************************************************************************
'Outlook COM Add-In project template
'This sample code provided by Micro Eye, Inc.
'http://www.microeye.com
'This code is unsupported, and cannot be posted or reproduced without
'explicit permission of Micro Eye, Inc.
'IDTExtensibility2 is the interface that COM Add-ins must implement.
'The project references the following object libraries:
'Add additional object libraries as required for your COM Add-in
'References:
'Microsoft Add-In Designer
'Microsoft Outlook 9.0 Object Library
'Microsoft Office 9.0 Object Library
'Class: OutAddIn
'Instancing: MultiUse
'Public Events:
'Public Functions:
'Public Properties:
'******************************************************************************
Option Explicit
'Object variables for Event procedures
Private WithEvents objOutlook As Outlook.Application
Private WithEvents olSentItems As Items
Private WithEvents objExpl As Outlook.Explorer
Private WithEvents objCBButton As Office.CommandBarButton
Private objCB As Office.CommandBar
Private objCBPop As Office.CommandBarPopup
'******************************************************************************
Public Event Send(MailItem As Object)
Public Event Attach(Selection As Outlook.Selection)
Private blnEnableSend As Boolean
Private blnEnableEmail As Boolean
Public Sub Display()
Dim blnNew As Boolean
' Test if the Items toolbar already exists
On Error Resume Next
LogNTEvent 1, vbLogEventTypeInformation, "Display method"
Set objCB = Application.ActiveExplorer.CommandBars("SHSMITH")
If Err Then
blnNew = True
' Create a new items toolbar.
Set objCB = Application.ActiveExplorer.CommandBars.Add(Name:="SHSMITH", Position:=msoBarRight, Temporary:=False)
Set objCBPop = objCB.Controls.Add(Type:=msoControlPopup)
With objCBPop
.Caption = "SHSMITH"
.ToolTipText = "Attach To Correspondence"
End With
Set objCBButton = CreateAddInCommandBarButton(gstrProgID, objCBPop, _
"Attach Email To Correspondence", "SHSMITH", "Attach To Email Correspondence", 1757, False, msoButtonCaption)
End If
'Display toolbar if new
If blnNew Then objCB.Visible = True
End Sub
Friend Sub InitHandler(olApp As Outlook.Application, strProgID As String)
On Error Resume Next
LogNTEvent 1, vbLogEventTypeInformation, "InitHandler"
'Declared WithEvents
'Instantiate a public module-level Outlook application variable and Outlook variable WithEvents
Set objOutlook = olApp
Set golApp = olApp
Set objExpl = objOutlook.ActiveExplorer
gstrProgID = strProgID
LogNTEvent 1, vbLogEventTypeInformation, "InitHandler and golapp is " & golApp & "objOutlook is " & objOutlook & "ProgID is " & gstrProgID
'CBOutlookItems objOutlook.ActiveExplorer.CurrentFolder
End Sub
Friend Sub UnInitHandler()
If Not objCB Is Nothing Then
objCB.Delete
End If
Set objCB = Nothing
Set objCBPop = Nothing
Set objCBButton = Nothing
Set golApp = Nothing
Set objOutlook = Nothing
End Sub
Private Sub Class_Initialize()
'Dim myFolder As MAPIFolder
'Dim myNameSpc As NameSpace
' blnEnableEmail = GetSetting("shsmith", "EnableMail", "EMAIL", True)
' If golApp Is Nothing Then
' LogNTEvent 1, vbLogEventTypeInformation, "Outlook is not open"
' If blnEnableEmail Then
' LogNTEvent 1, vbLogEventTypeInformation, "Outlook is not open SHSMITH has to open outlook"
' Set olOut = CreateObject("Outlook.Application")
' Set myNameSpc = olOut.GetNamespace("MAPI")
' Set myFolder = myNameSpc.GetDefaultFolder(olFolderInbox)
' myFolder.Display
'Set golApp = olOut
'Set objOutlook = olOut
'Set myNameSpc = Nothing
'Set olOut = Nothing
'End If
'End If
End Sub
Private Sub Class_Terminate()
If Not objCB Is Nothing Then
objCB.Delete
End If
Set objCB = Nothing
If Not golApp Is Nothing Then
golApp.Quit
End If
Set golApp = Nothing
Set objOutlook = Nothing
End Sub
Private Sub objCBButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
RaiseEvent Attach(Application.ActiveExplorer.Selection)
End Sub
Private Sub objExpl_Close()
If objExpl Is Nothing Then
Else
Set objExpl = Nothing
End If
UnInitHandler
End Sub
[B]Private Sub objOutlook_Startup()
Dim objNS As NameSpace
LogNTEvent 1, vbLogEventTypeInformation, "objOutlook object is starting up to listen to Sent items "
Set objNS = objOutlook.GetNamespace("MAPI")
Set olSentItems = objNS.GetDefaultFolder(olFolderSentMail).Items
'Set objNS = Nothing
End Sub
Private Sub olSentItems_ItemAdd(ByVal Item As Object)
Dim obItem As Object
blnEnableSend = GetSetting("shsmith", "EnableSend", "EMAILSEND", True)
If blnEnableSend Then
LogNTEvent 1, vbLogEventTypeInformation, "Send is enabled and I am going to raise the event " & objOutlook
Set obItem = Item
RaiseEvent Send(obItem)
End If
End Sub[/B]
Public Property Let MenuCaption(ByVal vNewValue As String)
' objCB.Name = vNewValue
End Property
Public Property Let ButtonCaption(ByVal vNewValue As String)
' objCBButton.Caption = vNewValue
End Property
Public Property Let ToolTipText(ByVal vNewValue As String)
' objCBButton.ToolTipText = vNewValue
End Property
Public Property Get Send_Enabled() As Variant
' Send_Enabled = blnSEnabled
End Property
Public Property Let Send_Enabled(ByVal vNewValue As Variant)
' blnSEnabled = vNewValue
End Property