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