OnAction and WithEvents - Connecting a Custom CommandBarButton to an action.

[Kevin Waddle]

Hello,

I am trying to take code that works in Outlook VBA and wrap it in a COM
Add-In.

I have everything figured out except the OnAction Event for the custom
CommandBar Buttons.

I have searched OutlookCode.Com and every other source I know.

Please review my code and see if you can point me in the right direction.

Thanks in Advance,
Kevin

I use the following code to create the buttons:
'From a Standard Module
'*** START CODE ***
Sub MakeMenu()
'Call the code to delete the CommandBar
Call DelMenu

Dim ButtonEvents As Collection
Dim ButtonEvent
Dim cls As New clsEmailSaver
Dim objACC As Object
Dim custBar As Office.CommandBar
Dim Cusbutton
Dim x, db, rs
Dim strDB As String

'Test to make sure the code has started
MsgBox "MenuCode Started"

Set custBar = _
Outlook.Application.ActiveExplorer.CommandBars.Add(Name:="Show", _
Position:=msoBarTop, Temporary:=True)

custBar.Visible = True

'Find the db to pull the menu items
strDB = cls.RegistryGet("EmailSaver", "DefaultPath", "dbPath") & "\Mail.mdb"

'Open Access
Set objACC = CreateObject("Access.Application")

'Open the db
objACC.OpenCurrentDatabase strDB
Set db = objACC.CurrentDb

'Open the Table
Set rs = db.openrecordset("CommandBarItems")

'Loop through the table...
With rs
x = 1
.MoveFirst
Do While Not .EOF
'...and create a button for each record...
Set Cusbutton =
custBar.Controls.Add(Type:=msoControlButton)
With
Outlook.Application.ActiveExplorer.CommandBars("Show").Controls(x)
.Style = msoButtonWrapCaption
.Caption = rs.fields("Caption")
.OnAction = rs.fields("OnAction")
.ToolTipText = rs.fields("ToolTipText")
.BeginGroup = rs.fields("BeginGroup")
.Tag = rs.fields("Tag")
End With

.MoveNext
x = x + 1
Loop
End With
db.Close
Set rs = Nothing
Set db = Nothing


'This is what I came up with to fire the code...not working
Set ButtonEvent = New cbEvents
For x = 1 To
Outlook.Application.ActiveExplorer.CommandBars("Show").Controls.count
Set ButtonEvent.cbBtn = _
Outlook.Application.ActiveExplorer.CommandBars("Show").Controls(x)

ButtonEvents.Add ButtonEvent

Debug.Print x
Next x

'Test to make sure code completed
MsgBox "MenuCode Finished"
End Sub


Public Sub DelMenu()
On Error Resume Next
Outlook.Application.ActiveExplorer.CommandBars("Show").Delete
End Sub
'*** END CODE ***



This is the OnClick Event I am trying to pull from a Class Module
'From a Class Module
'*** START CODE ***
Public WithEvents cbBtn As CommandBarButton

Private Sub cbBtn_Click(ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean)

'supress errors
On Error Resume Next

'check Tag property
Select Case Ctrl.Tag
Case "AddItemToDB"
Call AddItemToDB
Case "SaveMailItemToDrive"
Call SaveMailItemToDrive
Case "JunkIt"
Call JunkIt
Case "MailCalendar"
Call MailCalendar
End Select

'cancel looking for the sub specified in the OnAction property
CancelDefault = True

End Sub

 

[Ken Slovak - [MVP - Outlook]]

In a COM addin you should use the Application object passed to you in the
On_Connection event as the global Outlook object and derive all your other
Outlook objects from that Application object. That is a trusted Application
object.

In On_Connection you can also derive the COM addin's ProgID. That should be
assigned to a global string value. AddInInst.ProgId gives you that value.

You use that global ProgID to assign to the OnAction property of a button as
follows:

..OnAction = "!<" & gstrProgID & ">"

It's very important that when you are creating multiple buttons that you
assign unique Tag properties to each one. You also must declare the button
object WithEvents so it can handle the button's Click event.

Since you are deriving your buttons from a database recordset and may not
know the exact number of buttons to declare WithEvents statically in your
code you need a mechanism to handle a dynamically sized collection of
buttons. The way to do that is to set up a class module that contains a
WithEvents button declaration and it's own Click event handler. Then as you
add each button you instantiate an instance of that class module, assign the
button and it's Click event and properties and then add the button class to
a collection to keep the reference to the button alive.

When your shutdown code fires you destroy each member of the collection and
then release the collection.

You can see an example of a dynamic collection and class module for it in
the ItemsCB COM addin sample on the Resources page at www.microeye.com. That
wrapper class is for Explorers, but it illustrates the principle. ItemsCB
also has lots of important workarounds for handling when Outlook shuts down
and how to handle that to work around the bugs in the On_Disconnection
event.

 

[Kevin Waddle]

Ken,
Thank you for your reply.

It took me a while to work through the syntax to come up with
AddInInst.ProgID to pull the Unique ID.

I ended up using AddInInst.ProgID to populate a Global String during the
OnConnect Event

I also ended up not using the DB to pull the Command Bar Buttons.

With this being my first attempt at a COM Add-in I decided to simplify the
process.

Now for the next challenge...trying to figure out why code that is unchanged
from a VBA module fires the Outlook Security Warning when called from a COM
Add-In!

Thanks again for your help,
Kevin

 

[Ken Slovak - [MVP - Outlook]]

What version of Outlook? You never mentioned that.

Only Outlook 2003 or later intrinsically trust a COM addin that is written
correctly. By correctly I mean that all Outlook objects are derived from the
Application object passed in On_Connection. All other versions of Outlook
will fire the security prompts if you access a property that is subject to
the Outlook object model guard.

For compatibility across various Outlook versions many of us use a COM
library called Redemption (www.dimastr.com/redemption) to avoid the security
prompts. For more information on the Outlook object model guard and ways
around it see http://www.outlookcode.com/d/sec.htm

 

[Kevin Waddle]

Ken,

I am using OL2003. This my first attempt at an Add-In and my first attempt
at coding for Outlook outside of the VBA (Access, Excel and Internal
Outlook) I am still learning the rules of the road.

Can you recommend any examples of properly constructed add-ins?

What I have tried is to define Outlook objects in the Connect.dsr as
follows:
Public objOUT As Object
Public objOUTns As NameSpace
Public objOUTnsEX As Explorer


Then set the variables in the OnConnection
Set objOUT = outlook.Application
Set objOUTns = objOUT.GetNamespace("MAPI")
Set objOUTnsEX = objOUT.ActiveExplorer

In my Connect.dsr module I have two OnConnect subs:
Private Sub IDTExtensibility2_OnConnection(ByVal Application As Object,
ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _
ByVal AddInInst As Object, custom() As Variant)

Private Sub AddinInstance_OnConnection(ByVal Application As Object, _
ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal _
AddInInst As Object, custom() As Variant)

I have tried using each of these to pass the Object, one at a time and
together with no success.

The code that actually fires the security warning is as follows:
'Futher up in the sub I populate a collection (UniqueContacts) with all
email addresses saved in a db, I then
'try to add the email addresses from the
Outlook.Application.ActiveExplorer.Selection object passed as
'objOUTnsEX.Selection.Item(x).SenderEmailAddress. If the code errors out on
adding the email address
'Then it already exists and the user is offered the chance to change the
information, if not it simply updates the db.

For x = 1 To objOUTnsEX.Selection.count
UniqueContacts.Add objOUTnsEX.Selection.Item(x).SenderEmailAddress,
CStr(objOUTnsEX.Selection.Item(x).SenderEmailAddress)
If Err.Number = 457 Then
If MsgBox("The Email address ..." &
objOUTnsEX.Selection.Item(x).SenderEmailAddress _
& " ... is already stored in the database." _
& Chr(10) & Chr(10) & "It is set to save messages to " &
UniqueSaveLocations(objOUTnsEX.Selection.Item(x).SenderEmailAddress) _
& Chr(10) & Chr(10) & "Would you like to replace this with a
new 'Save to' directory?", _
vbQuestion + vbYesNo, "This email address is already
stored...") = vbYes Then
msg = "Save location for messages from " &
objOUTnsEX.Selection.Item(x).SenderEmailAddress
strPath = OpenFolderBrowser(msg)
strSQL = "UPDATE Mail SET Mail.EmailPath = '" & strPath & "'
WHERE (((Mail.EmailAddress)='" &
objOUTnsEX.Selection.Item(x).SenderEmailAddress & "'));"
objACC.DoCmd.RunSQL strSQL
End If
Else
'strPath = OpenFolderBrowser
msg = "Save location for messages from " &
objOUTnsEX.Selection.Item(x).SenderEmailAddress
strPath = OpenFolderBrowser(msg)

strSQL = "Insert Into Mail ([EmailAddress],[EmailPath])
values ('" & objOUTnsEX.Selection.Item(x).SenderEmailAddress & "','" &
strPath & "')"
objACC.DoCmd.RunSQL strSQL
Debug.Print strSQL
End If
Err.Number = 0
Next x


I appreciate any guidance you can give.

TIA,
Kevin

 

[Ken Slovak - [MVP - Outlook]]

Get rid of the AddInstance_xxx procedures and the Implements statement for
them. You don't need or want both sets. Either could be used but
IDTExtensibility2 is somewhat more standard.

You are firing the security prompts because you are harvesting email
addresses, just like a virus would and you are not using a trusted
Outlook.Application object.

In OnConnection you are passed an Application object. You use that to seed
your Outlook.Application object and then derive all other Outlook based
objects on that:

Public objOUT As Outlook.Application
Public objOUTns As Outlook.NameSpace
Public objOUTnsEX As Outlook.Explorer

In OnConnection:

Set objOUT = Application

then derive all your other objects from that:

Set objOUTns = objOUT.GetNameSpace("MAPI")

and so on.

Since you seem to be using VB 6 I would suggest downloading and studying the
ItemsCB COM addin template sample from the Resources page at
www.microeye.com. That shows many Outlook best practices for COM addins as
well as various workarounds for known Outlook COM addin bugs, such as
OnDisconnection not firing when Outlook is closed if any Outlook objects are
still instantiated at that point. That's the purpose of the Explorer wrapper
class and collection in ItemsCB.

Ken,

I am using OL2003. This my first attempt at an Add-In and my first
attempt at coding for Outlook outside of the VBA (Access, Excel and
Internal Outlook) I am still learning the rules of the road.

Can you recommend any examples of properly constructed add-ins?

What I have tried is to define Outlook objects in the Connect.dsr as
follows:
Public objOUT As Object
Public objOUTns As NameSpace
Public objOUTnsEX As Explorer


Then set the variables in the OnConnection
Set objOUT = outlook.Application
Set objOUTns = objOUT.GetNamespace("MAPI")
Set objOUTnsEX = objOUT.ActiveExplorer

In my Connect.dsr module I have two OnConnect subs:
Private Sub IDTExtensibility2_OnConnection(ByVal Application As Object,
ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _
ByVal AddInInst As Object, custom() As Variant)

Private Sub AddinInstance_OnConnection(ByVal Application As Object, _
ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal _
AddInInst As Object, custom() As Variant)

I have tried using each of these to pass the Object, one at a time and
together with no success.

The code that actually fires the security warning is as follows:
'Futher up in the sub I populate a collection (UniqueContacts) with all
email addresses saved in a db, I then
'try to add the email addresses from the
Outlook.Application.ActiveExplorer.Selection object passed as
'objOUTnsEX.Selection.Item(x).SenderEmailAddress. If the code errors out
on adding the email address
'Then it already exists and the user is offered the chance to change the
information, if not it simply updates the db.

For x = 1 To objOUTnsEX.Selection.count
UniqueContacts.Add objOUTnsEX.Selection.Item(x).SenderEmailAddress,
CStr(objOUTnsEX.Selection.Item(x).SenderEmailAddress)
If Err.Number = 457 Then
If MsgBox("The Email address ..." &
objOUTnsEX.Selection.Item(x).SenderEmailAddress _
& " ... is already stored in the database." _
& Chr(10) & Chr(10) & "It is set to save messages to " &
UniqueSaveLocations(objOUTnsEX.Selection.Item(x).SenderEmailAddress) _
& Chr(10) & Chr(10) & "Would you like to replace this with
a new 'Save to' directory?", _
vbQuestion + vbYesNo, "This email address is already
stored...") = vbYes Then
msg = "Save location for messages from " &
objOUTnsEX.Selection.Item(x).SenderEmailAddress
strPath = OpenFolderBrowser(msg)
strSQL = "UPDATE Mail SET Mail.EmailPath = '" & strPath &
"' WHERE (((Mail.EmailAddress)='" &
objOUTnsEX.Selection.Item(x).SenderEmailAddress & "'));"
objACC.DoCmd.RunSQL strSQL
End If
Else
'strPath = OpenFolderBrowser
msg = "Save location for messages from " &
objOUTnsEX.Selection.Item(x).SenderEmailAddress
strPath = OpenFolderBrowser(msg)

strSQL = "Insert Into Mail ([EmailAddress],[EmailPath])
values ('" & objOUTnsEX.Selection.Item(x).SenderEmailAddress & "','" &
strPath & "')"
objACC.DoCmd.RunSQL strSQL
Debug.Print strSQL
End If
Err.Number = 0
Next x


I appreciate any guidance you can give.

TIA,
Kevin