Multiplying Inspector Toolbar in Mail Item
Outlook 2003.
Windows XP and Word as my email editor
Hi,
I found this code on the internet which I have been playing around with. My
goal is to create two toolbars. One to show when you open a contact item and
another to show when you open, create and mail item. The contact Toolbar is
working perfect. It creates one when you open a contact item and deletes it
when you close.
However the Mail item is keeping multiplying itself every time I create a
new mail item. And it shows up in Word.This only happens when I create an new
item, not when I open an existing. Below is my code
-------------------------------------------------------------------------------------------
Class Module
Private WithEvents m_oInspector As Outlook.Inspector
Private WithEvents m_oMailItem As Outlook.MailItem
Private WithEvents m_oContactItem As Outlook.ContactItem
Private WithEvents ctlCBarControlF As Office.CommandBarButton
Private WithEvents ctlCBarControlM As Office.CommandBarButton
Private WithEvents ctlCBarControlT As Office.CommandBarButton
Private WithEvents ctlCBarControlL As Office.CommandBarButton
Private WithEvents ctlCBarControlSave As Office.CommandBarButton
Private WithEvents ctlCBarControlCategory As Office.CommandBarButton
Private m_lKey As Long
Friend Function Init(oInspector As Outlook.Inspector, ByVal lKey As Long) As
Boolean
Set m_oInspector = oInspector
Select Case True
Case (TypeOf oInspector.CurrentItem Is Outlook.ContactItem)
Set m_oContactItem = oInspector.CurrentItem
m_lKey = lKey
CreateButton oInspector
Init = True
Case (TypeOf oInspector.CurrentItem Is Outlook.MailItem)
Set m_oMailItem = oInspector.CurrentItem
m_lKey = lKey
MailCreateButton oInspector
Init = True
End Select
End Function
Private Sub MailCreateButton(Inspector As Outlook.Inspector)
Set colCB = Inspector.CommandBars
Dim cbEmail As Office.CommandBar
Dim ctlCBarButton As Office.CommandBarButton
Dim ctlCBarCombo As Office.CommandBarComboBox
Dim ctlCBarPopup As Office.CommandBarPopup
On Error Resume Next
Set cbEmail = Inspector.CommandBars("Email Toolbar")
If Err = 0 Then
cbEmail.Delete
End If
Set cbEmail = Inspector.CommandBars _
.Add(Name:="Email Toolbar", Position:=msoBarTop)
Set ctlCBarPopup = cbEmail.Controls.Add(Type:=msoControlPopup)
Set ctlCBarControlSave = ctlCBarPopup.Controls.Add(Type:=msoControlButton)
ctlCBarControlSave.Caption = "Save"
Set ctlCBarControlCategory =
ctlCBarPopup.Controls.Add(Type:=msoControlButton)
ctlCBarControlCategory.Caption = "Add Category"
With ctlCBarPopup
.Caption = "BBB Email Options"
End With
cbEmail.Visible = True
Set cbEmail = Nothing
End Sub
Private Sub CreateButton(Inspector As Outlook.Inspector)
Set colCB = Inspector.CommandBars
Dim cbTesting As Office.CommandBar
Dim ctlCBarButton As Office.CommandBarButton
Dim ctlCBarCombo As Office.CommandBarComboBox
Dim ctlCBarPopup As Office.CommandBarPopup
On Error Resume Next
Set cbTesting = Inspector.CommandBars("Toolbar")
If Err = 0 Then
cbTesting.Delete
End If
Set cbTesting = Inspector.CommandBars _
.Add(Name:="Toolbar", Position:=msoBarTop)
Set ctlCBarPopup = cbTesting.Controls.Add(Type:=msoControlPopup)
'Set ctlCBarControlF = ctlCBarPopup.Controls.Add(Type:=msoControlButton)
'ctlCBarControlF.Caption = "Fax"
Set ctlCBarControlL = ctlCBarPopup.Controls.Add(Type:=msoControlButton)
ctlCBarControlL.Caption = "Letter"
'Set ctlCBarControlM = ctlCBarPopup.Controls.Add(Type:=msoControlButton)
'ctlCBarControlM.Caption = "Memo"
Set ctlCBarControlT = ctlCBarPopup.Controls.Add(Type:=msoControlButton)
ctlCBarControlT.Caption = "Transmittal"
With ctlCBarPopup
.Caption = "Correspondence"
End With
cbTesting.Visible = True
End Sub
Friend Sub CloseInspector()
On Error Resume Next
Application.RemoveInspector m_lKey
Set YourButton = Nothing
Set m_oMailItem = Nothing
Set m_oInspector = Nothing
End Sub
Private Sub Class_Initialize()
' In this case this method isn´t necessary but helps to _
understand what´s going on.
' Before executing this method this object doesn´t exist. _
That is, the member (variables) are unkown, no events can _
be received etc.
End Sub
Private Sub Class_Terminate()
' In this case this method isn´t necessary but helps to _
understand what´s going on.
' This method is being executed if the object is being destroyed. _
That is, after that all member are unknown again.
End Sub
' Set breakpoint (F9) at the next line
Private Sub m_oInspector_Close()
On Error Resume Next
Set cbTesting = Application.ActiveInspector.CommandBars("Toolbar")
If Err = 0 Then
cbTesting.Delete
End If
Set cbEmail = Application.ActiveInspector.CommandBars("Email Toolbar")
If Err = 0 Then
cbEmail.Delete
End If
CloseInspector
End Sub
' Set breakpoint (F9) at the next line
Private Sub m_oMailItem_Close(Cancel As Boolean)
On Error Resume Next
' If m_oMailItem.Saved Then
Set cbEmail = Application.ActiveInspector.CommandBars("Email Toolbar")
If Err = 0 Then
cbEmail.Delete
End If
CloseInspector
' End If
End Sub
' Set breakpoint (F9) at the next line
Private Sub m_oMailItem_Send(Cancel As Boolean)
On Error Resume Next
Set cbEmail = Application.ActiveInspector.CommandBars("Email Toolbar")
If Err = 0 Then
cbEmail.Delete
End If
CloseInspector
End Sub
' Set breakpoint (F9) at the next line
Private Sub m_oContactItem_Close(Cancel As Boolean)
On Error Resume Next
Set cbTesting = Application.ActiveInspector.CommandBars("Toolbar")
If Err = 0 Then
cbTesting.Delete
End If
CloseInspector
End Sub
Private Sub ctlCBarControlSave_Click(ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean _
)
frmEmail.Show vbModal
'vbModeless
End Sub
Private Sub ctlCBarControlCategory_Click(ByVal Ctrl As
Office.CommandBarButton, _
CancelDefault As Boolean _
)
frmCategory.Show
End Sub
ThisOutlook Session
Private Sub Application_Startup()
On Error Resume Next
Dim objNS As NameSpace
Set m_colInspectors = Application.Inspectors
Set m_coll = New VBA.Collection
Set objNS = Nothing
End Sub
' Set breakpoint (F9) at the next line
Private Sub m_colInspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
' Check the Inspector´s CurrentItem type and decide _
whether to handle that type or not.
Select Case True
Case (TypeOf Inspector.CurrentItem Is Outlook.MailItem)
AddMailItemWrapper Inspector
Case (TypeOf Inspector.CurrentItem Is Outlook.ContactItem)
'CreateButton Inspector
AddMailItemWrapper Inspector
End Select
End Sub
Private Sub AddMailItemWrapper(oInspector As Outlook.Inspector)
Dim oChild As cInspector
' Create and init a new Inspector wrapper.
Set oChild = New cInspector
If oChild.Init(oInspector, m_lNextKey) Then
m_coll.Add oChild, CStr(m_lNextKey)
m_lNextKey = m_lNextKey + 1
End If
End Sub
Public Sub RemoveInspector(ByVal lKey As Long)
On Error Resume Next
m_coll.Remove CStr(lKey)
End Sub
|