A
Adam Killbey
Outlook COM Addin with Visual Basic
I have created an Outlook COM Addin that replaces the Save and Send
buttons within the Menu Bar and Command Bar with my own Save and Send
Command Bar within the Mail Message. However when I press the button my
code will not execute.
If I put my Command bar into the main Outlook window the code will
execute.
What am I missing and what do I need to change.
Here is an example of my code
Implements IDTExtensibility2
Dim WithEvents oApp As Outlook.Application
Dim oCB As Office.CommandBarButton
Dim oCBs As Office.CommandBars
Dim oCommandBar As Office.CommandBar
Dim WithEvents oNS As Outlook.NameSpace
Dim WithEvents oSaveCB As Office.CommandBarButton
Dim WithEvents oSendCB As Office.CommandBarButton
Dim WithEvents oResetCB As Office.CommandBarButton
Dim oMyControl
Dim oNewPage
Dim myItem
Dim oFolder As Outlook.MAPIFolder
Private Sub IDTExtensibility2_OnAddInsUpdate( _
custom() As Variant)
End Sub
Private Sub IDTExtensibility2_OnBeginShutdown( _
custom() As Variant)
On Error Resume Next
Set oApp = Nothing
Set oCBs = Nothing
Set oCommandBar = Nothing
Set oNS = Nothing
Set oCB = Nothing
Set oResetCB = Nothing
Set oSaveCB = Nothing
Set oSendCB = Nothing
Set oFolder = Nothing
Set myItem = Nothing
End Sub
Private Sub IDTExtensibility2_OnConnection( _
ByVal Application As Object, ByVal ConnectMode As _
AddInDesignerObjects.ext_ConnectMode, _
ByVal AddInInst As Object, custom() As Variant)
Dim Count As Long
Set oApp = Application
Set oNS = oApp.GetNamespace("MAPI")
Set myItem = oApp.CreateItem(olMailItem)
Set oCBs = myItem.GetInspector.CommandBars
For Count = 1 To oCBs.Count
If oCBs.Item(Count).Name = "Comparto ToolBar" Then
Set oCommandBar = oCBs.Item(Count)
oCommandBar.Delete
Set oCommandBar = Nothing
Exit For
End If
Next Count
Set oCommandBar = oCBs.Add("Comparto ToolBar", msoBarLeft & msoBarTop,
False, False)
oCommandBar.Visible = False
Set oSaveCB = _
oCommandBar.Controls.Add(Type:=msoControlButton, Temporary:=False,
Before:=1)
oSaveCB.Caption = "&Save"
oSaveCB.FaceId = 3
oSaveCB.Enabled = True
oSaveCB.Style = msoButtonIconAndCaption
Set oSendCB = _
oCommandBar.Controls.Add(Type:=msoControlButton, Temporary:=False,
Before:=2)
oSendCB.Caption = "S&end"
oSendCB.FaceId = 2617
oSendCB.Enabled = True
oSendCB.Style = msoButtonIconAndCaption
oCommandBar.Controls.Add Type:=msoControlButton, ID:=4, Before:=3
oCommandBar.Controls.Add Type:=msoControlButton, ID:=21, Before:=4
oCommandBar.Controls.Add Type:=msoControlButton, ID:=19, Before:=5
oCommandBar.Controls.Add Type:=msoControlButton, ID:=22, Before:=6
Set oResetCB = oCommandBar.Controls.Add( _
Type:=msoControlButton, Temporary:=False, Before:=8)
oResetCB.Caption = "&Reset Menu"
oResetCB.Enabled = True
oResetCB.Visible = True
myItem.Close olDiscard
Set myItem = Nothing
End Sub
Private Sub IDTExtensibility2_OnDisconnection( _
ByVal RemoveMode As _
AddInDesignerObjects.ext_DisconnectMode, _
custom() As Variant)
Set myItem = oApp.CreateItemFromTemplate("C:\Program
Files\CompartoOutlookAddIn\CompartoMessage.oft")
oCommandBar.Delete
myItem.Close olDiscard
Set myItem = Nothing
End Sub
Private Sub IDTExtensibility2_OnStartupComplete( _
custom() As Variant)
End Sub
Private Sub oSaveCB_Click( _
ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean)
Dim SafeMail
Dim SaveFileLocn As String
Dim myItem As Inspector
Dim objItem As Object
MsgBox "You clicked Save!"
Open "C:\~CTempMail.cmf" For Input As #1
Line Input #1, SaveFileLocn
Close #1
Set SafeMail = CreateObject("Redemption.SafeMailItem")
Set myItem = oApp.ActiveInspector
If Not TypeName(myItem) = "Nothing" Then
Set objItem = myItem.CurrentItem
Set SafeMail.Item = objItem
SafeMail.SaveAs SaveFileLocn, olMSG
End If
SafeMail.Close olDiscard
myItem.Close olDiscard
Set SafeMail = Nothing
End Sub
Private Sub oSendCB_Click( _
ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean)
Dim myItem As Inspector
Dim objItem As Object
Dim SaveFileLocn As String
Dim SafeMail
MsgBox "You clicked Send!"
Open "C:\~CTempMail.cmf" For Input As #1
Line Input #1, SaveFileLocn
Close #1
Set SafeMail = CreateObject("Redemption.SafeMailItem")
Set myItem = oApp.ActiveInspector
If Not TypeName(myItem) = "Nothing" Then
Set objItem = myItem.CurrentItem
Set SafeMail.Item = objItem
SafeMail.SaveAs SaveFileLocn, olMSG
SafeMail.Send
End If
SafeMail.Close olDiscard
myItem.Close olDiscard
Set SafeMail = Nothing
End Sub
Private Sub oNS_OptionsPagesAdd( _
ByVal Pages As Outlook.PropertyPages, _
ByVal Folder As Outlook.MAPIFolder)
If Folder.Name = oFolder.Name Then
Set oNewPage = CreateObject("TestPropPage.PropPage")
Pages.Add oNewPage
End If
End Sub
Private Sub oApp_OptionsPagesAdd( _
ByVal Pages As Outlook.PropertyPages)
Set oNewPage = CreateObject("TestPropPage.PropPage")
Pages.Add oNewPage
End Sub
Private Sub oResetCB_Click( _
ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean)
oCommandBar.Delete
End Sub
I have created an Outlook COM Addin that replaces the Save and Send
buttons within the Menu Bar and Command Bar with my own Save and Send
Command Bar within the Mail Message. However when I press the button my
code will not execute.
If I put my Command bar into the main Outlook window the code will
execute.
What am I missing and what do I need to change.
Here is an example of my code
Implements IDTExtensibility2
Dim WithEvents oApp As Outlook.Application
Dim oCB As Office.CommandBarButton
Dim oCBs As Office.CommandBars
Dim oCommandBar As Office.CommandBar
Dim WithEvents oNS As Outlook.NameSpace
Dim WithEvents oSaveCB As Office.CommandBarButton
Dim WithEvents oSendCB As Office.CommandBarButton
Dim WithEvents oResetCB As Office.CommandBarButton
Dim oMyControl
Dim oNewPage
Dim myItem
Dim oFolder As Outlook.MAPIFolder
Private Sub IDTExtensibility2_OnAddInsUpdate( _
custom() As Variant)
End Sub
Private Sub IDTExtensibility2_OnBeginShutdown( _
custom() As Variant)
On Error Resume Next
Set oApp = Nothing
Set oCBs = Nothing
Set oCommandBar = Nothing
Set oNS = Nothing
Set oCB = Nothing
Set oResetCB = Nothing
Set oSaveCB = Nothing
Set oSendCB = Nothing
Set oFolder = Nothing
Set myItem = Nothing
End Sub
Private Sub IDTExtensibility2_OnConnection( _
ByVal Application As Object, ByVal ConnectMode As _
AddInDesignerObjects.ext_ConnectMode, _
ByVal AddInInst As Object, custom() As Variant)
Dim Count As Long
Set oApp = Application
Set oNS = oApp.GetNamespace("MAPI")
Set myItem = oApp.CreateItem(olMailItem)
Set oCBs = myItem.GetInspector.CommandBars
For Count = 1 To oCBs.Count
If oCBs.Item(Count).Name = "Comparto ToolBar" Then
Set oCommandBar = oCBs.Item(Count)
oCommandBar.Delete
Set oCommandBar = Nothing
Exit For
End If
Next Count
Set oCommandBar = oCBs.Add("Comparto ToolBar", msoBarLeft & msoBarTop,
False, False)
oCommandBar.Visible = False
Set oSaveCB = _
oCommandBar.Controls.Add(Type:=msoControlButton, Temporary:=False,
Before:=1)
oSaveCB.Caption = "&Save"
oSaveCB.FaceId = 3
oSaveCB.Enabled = True
oSaveCB.Style = msoButtonIconAndCaption
Set oSendCB = _
oCommandBar.Controls.Add(Type:=msoControlButton, Temporary:=False,
Before:=2)
oSendCB.Caption = "S&end"
oSendCB.FaceId = 2617
oSendCB.Enabled = True
oSendCB.Style = msoButtonIconAndCaption
oCommandBar.Controls.Add Type:=msoControlButton, ID:=4, Before:=3
oCommandBar.Controls.Add Type:=msoControlButton, ID:=21, Before:=4
oCommandBar.Controls.Add Type:=msoControlButton, ID:=19, Before:=5
oCommandBar.Controls.Add Type:=msoControlButton, ID:=22, Before:=6
Set oResetCB = oCommandBar.Controls.Add( _
Type:=msoControlButton, Temporary:=False, Before:=8)
oResetCB.Caption = "&Reset Menu"
oResetCB.Enabled = True
oResetCB.Visible = True
myItem.Close olDiscard
Set myItem = Nothing
End Sub
Private Sub IDTExtensibility2_OnDisconnection( _
ByVal RemoveMode As _
AddInDesignerObjects.ext_DisconnectMode, _
custom() As Variant)
Set myItem = oApp.CreateItemFromTemplate("C:\Program
Files\CompartoOutlookAddIn\CompartoMessage.oft")
oCommandBar.Delete
myItem.Close olDiscard
Set myItem = Nothing
End Sub
Private Sub IDTExtensibility2_OnStartupComplete( _
custom() As Variant)
End Sub
Private Sub oSaveCB_Click( _
ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean)
Dim SafeMail
Dim SaveFileLocn As String
Dim myItem As Inspector
Dim objItem As Object
MsgBox "You clicked Save!"
Open "C:\~CTempMail.cmf" For Input As #1
Line Input #1, SaveFileLocn
Close #1
Set SafeMail = CreateObject("Redemption.SafeMailItem")
Set myItem = oApp.ActiveInspector
If Not TypeName(myItem) = "Nothing" Then
Set objItem = myItem.CurrentItem
Set SafeMail.Item = objItem
SafeMail.SaveAs SaveFileLocn, olMSG
End If
SafeMail.Close olDiscard
myItem.Close olDiscard
Set SafeMail = Nothing
End Sub
Private Sub oSendCB_Click( _
ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean)
Dim myItem As Inspector
Dim objItem As Object
Dim SaveFileLocn As String
Dim SafeMail
MsgBox "You clicked Send!"
Open "C:\~CTempMail.cmf" For Input As #1
Line Input #1, SaveFileLocn
Close #1
Set SafeMail = CreateObject("Redemption.SafeMailItem")
Set myItem = oApp.ActiveInspector
If Not TypeName(myItem) = "Nothing" Then
Set objItem = myItem.CurrentItem
Set SafeMail.Item = objItem
SafeMail.SaveAs SaveFileLocn, olMSG
SafeMail.Send
End If
SafeMail.Close olDiscard
myItem.Close olDiscard
Set SafeMail = Nothing
End Sub
Private Sub oNS_OptionsPagesAdd( _
ByVal Pages As Outlook.PropertyPages, _
ByVal Folder As Outlook.MAPIFolder)
If Folder.Name = oFolder.Name Then
Set oNewPage = CreateObject("TestPropPage.PropPage")
Pages.Add oNewPage
End If
End Sub
Private Sub oApp_OptionsPagesAdd( _
ByVal Pages As Outlook.PropertyPages)
Set oNewPage = CreateObject("TestPropPage.PropPage")
Pages.Add oNewPage
End Sub
Private Sub oResetCB_Click( _
ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean)
oCommandBar.Delete
End Sub