[RESOLVED] Right-click options Open MailItem in Outlook App

[RiceRocket]

I have coded a pretty extensive Excel project for use at work. It basically tracks issues with engineering projects. This "tracker" has a TON of features available and I would like to add one more. The feature I'm trying to add would allow a user to open an Outlook mail item, highlight text in the mail item, then right click in the window and select "Export to Tracker" from the right-click menu which would then bring up a prompt and ultimately copy the info over to my tracker. I have experience with Outlook Automation through Excel (even though its not much) so I know a little bit of Outlook VB but not much.

Of course, any snipets of code would be great, however I really just want to know if I can add an option to the right-click menu through VB. If that is not possible, I can always add a toolbar button to perform the same task. The only problem with that is I don't know any Outlook VB

Any help would be GREATLY appreciated!!!

[RobDog888]

Outlook VBA is the same as Excel VBA. Adding a menu item to Outlook default Context menu is very difficult and I have not seen a single VB 6 or VBA solution suceed. Your better off creating a toolbar button on the Inspector window or creating a custom Context menu but only with your menu items on it. If you need the original items also you could try to duplicate their actions but too much work if you ask me.

[RiceRocket]

Thanks Rob,

I do realize that Excel and Outlook share the same VBA code, I am just not familiar with the objects, items, etc. that are native to Outlook only.

For ease's sake, I think I'm going to go with adding a toolbar button to the inspector window. I can do this via GUI commands, but I'm not sure how to implement this with code. Do you have any examples of this code?

Thanks again in advance!

[RobDog888]

Yes, search by my username and Commandbar and/or toolbar/menu.

[RiceRocket]

Hi RobDog,

OK, I have two questions. First, I added your code to the ThisOutlookSession to add a menu option "Tools" -> "Add to AR Tracker..." which adds the menu item to the Outlook window. I would also like to add this menu item to the tools menu of an open email (basically added to EVERY email that is opened). How would I go about doing that?

Option Explicit
'Behind ThisOutlookSession
Public WithEvents oMnuSaveAs As Office.CommandBarButton
 
Private Sub SyncMnuSaveAsButton(btn As Office.CommandBarButton)
    Set oMnuSaveAs = btn
    If btn Is Nothing Then
        MsgBox "Sync. of '" & btn.Caption & "' button event failed!", vbCritical + vbOKOnly
    End If
End Sub
 
Private Sub Application_MAPILogonComplete()
    
    Dim oCBmnuTools As Office.CommandBarPopup
    Dim oCBmnuSaveMe As Office.CommandBarButton
    
    '<ADD A MENU ITEM>
    Set oCBmnuTools = Application.ActiveExplorer.CommandBars("Menu Bar").Controls("&Tools")
    Set oCBmnuSaveMe = Application.ActiveExplorer.CommandBars("Menu Bar").FindControl(msoControlButton, 1, "888", True, True)
    If TypeName(oCBmnuSaveMe) = "Nothing" Then
        Set oCBmnuSaveMe = oCBmnuTools.Controls.Add(msoControlButton, 1, "888", , True)
    End If
    With oCBmnuSaveMe
        .BeginGroup = True
        .Caption = "Add to AR Tracker..."
        .Enabled = True
        .Style = msoControlCustom
        .Tag = "888"
        .Visible = True
    End With
    Call SyncMnuSaveAsButton(oCBmnuSaveMe)
    '</ADD A MENU ITEM>
End Sub
 
Private Sub oMnuSaveAs_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    MsgBox "oMnuSaveAs_Click"
End Sub

Second, I would like the oMnuSaveAs_Click to start a form in which information about the engineering issue can be entered which will then get put in the tracker. If the active window is the inbox screen, i would like to select the mailitem that is highlighted in the window and then bring up a form to enter in more info about the info to track. Or, if the email is open, I would like to use the selected text and insert it into a form... the rest of the info in the form will be inserted into the tracker...

I know this sounds like alot, but i basically am having trouble activating the inbox (i think its olFolderInbox) or activating an open mail item and selected text.

As always, thanks a ton!!

[RiceRocket]

Hi RobDog,

I really appreciate the code you gave me (above). I do have one issue with it. It seems that once I click Tools -> Add to AR Tracker... and execute my code, it seems to disable the command bar button. If I try to click it again, nothing happens. To solve this, I have to manually run the Application_MAPILogonComplete() event before the command bar button will function again. Is there a way around this? I tried to Call Application_MAPILogonComplete() after executing my code (it does call correctly and execute the code correctly), but for some reason, the command bar button still doesn't work. Any suggestions?

BTW, please disregard my last post. That was some time ago and I am WAY farther into my project than that.

Thanks again to the VBA guru!!!

[RobDog888]

Do you have more then one explorer open (Outlook)? There is no disableing code above or do you mean it just looks enabled but doesnt work?[/color]

[RiceRocket]

I only have one instance of Outlook open and I'm pretty sure I don't create a new explorer anywhere in code (if thats even possible). The button definitely looks enabled, but won't work. It does work, on the first try, however any subsequent tries always fail. This is such a small issue, but it's killing my debug time... anything at all to help would be awesome!! Thanks again, robdog!

[RobDog888]

Do you have other code in the click event? Perhaps there is an error somewhere that is breaking the event. Or are you using it exactly as posted?

[RiceRocket]

This is the code I am using in ThisOutlookSession:

Option Explicit
'Behind ThisOutlookSession
Public WithEvents oMnuSaveAs As Office.CommandBarButton
 
Private Sub SyncMnuSaveAsButton(btn As Office.CommandBarButton)
    Set oMnuSaveAs = btn
    If btn Is Nothing Then
        MsgBox "Sync. of '" & btn.Caption & "' button event failed!", vbCritical + vbOKOnly
    End If
End Sub
 
'Public Sub Application_MAPILogonComplete()
'
'    Dim oCBmnuTools As Office.CommandBarPopup
'    Dim oCBmnuSaveMe As Office.CommandBarButton
'
'    '<ADD A MENU ITEM>
'    Set oCBmnuTools = Application.ActiveExplorer.CommandBars("Menu Bar").Controls("&Tools")
'    Set oCBmnuSaveMe = Application.ActiveExplorer.CommandBars("Menu Bar").FindControl(msoControlButton, 1, "888", True, True)
'    If TypeName(oCBmnuSaveMe) = "Nothing" Then
'        Set oCBmnuSaveMe = oCBmnuTools.Controls.Add(msoControlButton, 1, "888", , True)
'    End If
'    With oCBmnuSaveMe
'        .BeginGroup = True
'        .Caption = "Add to AR Tracker..."
'        .Enabled = True
'        .Style = msoControlCustom
'        .Tag = "888"
'        .Visible = True
'    End With
'    Call SyncMnuSaveAsButton(oCBmnuSaveMe)
'    '</ADD A MENU ITEM>
'End Sub
 
Public Sub Application_Startup()
    Dim oCBmnuTools As Office.CommandBarPopup
    Dim oCBmnuSaveMe As Office.CommandBarButton
    
    '<ADD A MENU ITEM>
    Set oCBmnuTools = Application.ActiveExplorer.CommandBars("Menu Bar").Controls("&Tools")
    Set oCBmnuSaveMe = Application.ActiveExplorer.CommandBars("Menu Bar").FindControl(msoControlButton, 1, "888", True, True)
    If TypeName(oCBmnuSaveMe) = "Nothing" Then
        Set oCBmnuSaveMe = oCBmnuTools.Controls.Add(msoControlButton, 1, "888", , False)
    End If
    With oCBmnuSaveMe
        .BeginGroup = True
        .Caption = "Add to AR Tracker..."
        .Enabled = True
        .Style = msoControlCustom
        .Tag = "888"
        .Visible = True
        .OnAction = "oMnuSaveAs_Click()"
    End With
    Call SyncMnuSaveAsButton(oCBmnuSaveMe)
    '</ADD A MENU ITEM>
End Sub
 
Private Sub oMnuSaveAs_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
Dim oApp        As Outlook.Application
Dim myExplorers As Outlook.Explorer
Dim myExpSel    As Outlook.Selection
Dim oEmail      As Outlook.MailItem
 
Set oApp = GetObject(, "Outlook.Application")
Set myExplorers = oApp.ActiveExplorer
Set myExpSel = myExplorers.Selection
Set oEmail = myExpSel.Item(1)
    
    Call FindOutlookEmail(oEmail.EntryID, oEmail.Subject) 'Determine if its already in tracker, set recordneedstobedeleted flag
    Call arInfo.AR_Menu_Click 'Add current email (calls Outlook_Emails_2_Access)
    If recordNeedsDeleting Then Call DeleteRecord   'Delete selected records in SimilarARs form
    
    
    Call Application_Startup
    
    Unload arInfo
    Unload SimilarARs
    Set oEmail = Nothing
    Set myExplorers = Nothing
    Set myExpSel = Nothing
End Sub

I tried to move the commandbar button code to the Application_Startup event from the Application_MAPILogonComplete event. It still didn't work. Hope this helps...

[RobDog888]

Dont use the .OnAction property as we are already using the sync procedure to link up the button to the withevents.

Also, since this is in outlook vba you dont need to define an application object, just use Application as its the default object of the current running instance.

And dont use Application_Startup as it fires before the GUI is initialized and may give you issues initializing the button. The Application_MAPILogonComplete is the last event to fire and should be the one your using.

Dont can the Application_Startup event again as its already initialized with the with events. all these duplicate calls may be breaking the event.

[RiceRocket]

Wow, I think it had everything to do with the GetObject(, "Outlook.Application"). Thanks for the help, robdog!!!

[RobDog888]

Cool, glad its Resolved then?

[RiceRocket]

Yep!

[RiceRocket]

Sorry to keep re-opening this thread, but i have just one more question.

Do you have any sample code that i can look at that would allow me to have a submenu under Tools -> Add to AR Tracker... -> SubMenuItem1, SubMenuItem2, etc?

[RobDog888]

Its the same technique but the first main item should be added as a CommandBarPopup type instead. Then add menu items to it.

[RiceRocket]

Awesome!! I was able to confiure the menu EXACTLY how I wanted. Thanks again for your help. I've posted my code in case anyone wants to see what i did...

Private Sub Application_MAPILogonComplete()
    Dim arMenu As Office.CommandBarPopup
    Dim currentMenuBar As Office.CommandBar
    Dim oCBmnuTools As Office.CommandBarPopup
    Dim oCBmnuAddToTrackerMain As Office.CommandBarPopup
    Dim oCBmnuTracker1 As Office.CommandBarButton
    Dim oCBmnuTrackerAdd As Office.CommandBarButton
 
    Set currentMenuBar = Application.ActiveExplorer.CommandBars.ActiveMenuBar
    currentMenuBar.Reset
    Set arMenu = currentMenuBar.Controls.Add(msoControlPopup, 1)
    Set oCBmnuAddToTrackerMain = arMenu.Controls.Add(msoControlPopup, 1)
    Set oCBmnuTrackerAdd = arMenu.Controls.Add(msoControlButton, 1)
    Set oCBmnuTracker1 = oCBmnuAddToTrackerMain.Controls.Add(msoControlButton, 1, "888", , False)
    
    With arMenu
        .BeginGroup = True
        .Caption = "AR Tracker"
        .Enabled = True
        .Visible = True
    End With
    With oCBmnuAddToTrackerMain
        .BeginGroup = True
        .Caption = "Add to AR Tracker"
        .Enabled = True
        '.Style = msoControlCustom
        .Tag = "888"
        .Visible = True
    End With
    With oCBmnuTrackerAdd
        .BeginGroup = True
        .Caption = "Add Database to this list..."
        .Enabled = True
        .Style = msoControlCustom
        .Visible = True
    End With
    With oCBmnuTracker1
        .BeginGroup = False
        .Caption = "Blackford Issues"
        .Enabled = True
        .Style = msoControlCustom
        .Tag = "888"
        .Visible = True
    End With
    
    Set oMnuTrackerSub1 = oCBmnuTracker1 ' Set buttons to have WithEvents
    Set oMnuTrackerAdd = oCBmnuTrackerAdd
    
End Sub

[RobDog888]

but dont forget to change your .Tag property for each menu item as you may need to reference or find it later and currently they all have the same "888" tag.

[RiceRocket]

Hi Robdog,

I am having the same issue again as I was before. The problem is that when I use the menu bar buttons to run my code, the code will execute, however the next time I attempt to click the menu bar button, nothing happens. I am basically using my ThisOutlookSession as my main, where all function calls happen from ThisOutlookSession and everything ultimately returns to ThisOutlookSession to finish up. Here's my code for the entire ThisOutlookSession (sorry it is really long, but I REALLY AM IN DESPERATION!!). If an error occurs anywhere in the other functions, then a boolean flag called "quitting" is set and thus prevents any other function calls from ThisOutlookSession. Basically my program is worthless if I can't fix this problem!!

' PART 1 of 2
 
Option Explicit
'Behind ThisOutlookSession
Public WithEvents oMnuTrackerSub0 As Office.CommandBarButton
Public WithEvents oMnuTrackerSub1 As Office.CommandBarButton
Public WithEvents oMnuTrackerSub2 As Office.CommandBarButton
Public WithEvents oMnuTrackerSub3 As Office.CommandBarButton
Public WithEvents oMnuTrackerSub4 As Office.CommandBarButton
Public WithEvents oMnuTrackerSub5 As Office.CommandBarButton
Public WithEvents oMnuTrackerSub6 As Office.CommandBarButton
Public WithEvents oMnuTrackerSub7 As Office.CommandBarButton
Public WithEvents oMnuTrackerSub8 As Office.CommandBarButton
Public WithEvents oMnuTrackerSub9 As Office.CommandBarButton
Public WithEvents oMnuTrackerSub10 As Office.CommandBarButton
Public WithEvents oMnuTrackerSub11 As Office.CommandBarButton
Public WithEvents oMnuTrackerSub12 As Office.CommandBarButton
Public WithEvents oMnuTrackerSub13 As Office.CommandBarButton
Public WithEvents oMnuTrackerSub14 As Office.CommandBarButton
Public WithEvents oMnuTrackerAdd As Office.CommandBarButton
Public arInfo_Close As Label
Public connectionString As String
Public quitting As Boolean
 
Private Sub SyncMnuTracker1Button(btn As Office.CommandBarButton)
    Set oMnuTrackerSub1 = btn
    
    If btn Is Nothing Then
        MsgBox "Sync. of '" & btn.Caption & "' button event failed!", vbCritical + vbOKOnly
    End If
End Sub
 
Public Sub Application_MAPILogonComplete()
    Dim arStatus As Office.CommandBar
    Dim CBtxt_arStatus As Office.CommandBarControl
    Dim arMenu As Office.CommandBarPopup
    Dim currentMenuBar As Office.CommandBar
    Dim oCBmnuTools As Office.CommandBarPopup
    Dim oCBmnuAddToTrackerMain As Office.CommandBarPopup
    Dim oCBButtons(100) As Controls
    Dim oCBmnuTrackerAdd As Office.CommandBarButton
    
    '<ADD A MENU ITEM>
    Set currentMenuBar = Application.ActiveExplorer.CommandBars.ActiveMenuBar
    currentMenuBar.Reset
    Set arMenu = currentMenuBar.Controls.Add(msoControlPopup, 1)
    Set oCBmnuAddToTrackerMain = arMenu.Controls.Add(msoControlPopup, 1)
    Set oCBmnuTrackerAdd = arMenu.Controls.Add(msoControlButton, 1)
    Set arStatus = Application.ActiveExplorer.CommandBars(Application.ActiveExplorer.CommandBars.Count)
    If Not arStatus.name = "AR Tracker Status ToolBar" Then
        Set arStatus = Application.ActiveExplorer.CommandBars.Add("AR Tracker Status ToolBar", msoBarTop, False, True)
        Set CBtxt_arStatus = arStatus.Controls.Add(1)
    End If
    Set CBtxt_arStatus = arStatus.FindControl(1)
    
    'Set oCBmnuTools = Application.ActiveExplorer.CommandBars("Menu Bar").Controls("&Tools")
    'Set oCBmnuAddToTrackerMain = Application.ActiveExplorer.CommandBars("Menu Bar").FindControl(msoControlPopup, 1, "888", True, True)
    ''oCBmnuTools.Reset
    'If TypeName(oCBmnuAddToTrackerMain) = "Nothing" Then
    '    Set oCBmnuAddToTrackerMain = oCBmnuTools.Controls.Add(msoControlPopup, 1)
    'End If
    'Set oCBmnuTracker1 = oCBmnuAddToTrackerMain.Controls.Add(msoControlButton, 1, "888", , False)
    With Application.ActiveExplorer.CommandBars("AR Tracker Status ToolBar")
        .Left = 200
        .Visible = True
    End With
    With arMenu
        .BeginGroup = True
        .Caption = "A&R Tracker"
        .Enabled = True
        .Visible = True
    End With
    With oCBmnuAddToTrackerMain
        .BeginGroup = True
        .Caption = "Add to AR Tracker"
        .Enabled = True
        '.Style = msoControlCustom
        '.Tag = "888"
        .Visible = True
    End With
    With oCBmnuTrackerAdd
        .BeginGroup = True
        .Caption = "Add Database to this list..."
        .Enabled = True
        .Style = msoControlCustom
        .Visible = True
    End With
    With CBtxt_arStatus
        .BeginGroup = False
        .Width = 2000
        .Caption = "AR Tracker Status: Ready"
        .Tag = "AR Tracker Status ToolBar"
        .Enabled = True
        .Visible = True
    End With
    
    If Not restarting Then
    'Set oMnuTrackerSub1 = oCBmnuTracker1 ' Set buttons to have WithEvents
        Set oMnuTrackerAdd = oCBmnuTrackerAdd
        Call Populate_CB_Array(oCBmnuAddToTrackerMain)
    'Call SyncMnuTracker1Button(oCBmnuTracker1)
    '</ADD A MENU ITEM>
    End If
End Sub
 
Private Sub oMnuTrackerAdd_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    DBadd.Show
End Sub
 
Private Sub oMnuTrackerSub0_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub
Private Sub oMnuTrackerSub1_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub
Private Sub oMnuTrackerSub2_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub
Private Sub oMnuTrackerSub3_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub
Private Sub oMnuTrackerSub4_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub
Private Sub oMnuTrackerSub5_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub
Private Sub oMnuTrackerSub6_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub
Private Sub oMnuTrackerSub7_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub
Private Sub oMnuTrackerSub8_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub
Private Sub oMnuTrackerSub9_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub
Private Sub oMnuTrackerSub10_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub
Private Sub oMnuTrackerSub11_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub
Private Sub oMnuTrackerSub12_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub
Private Sub oMnuTrackerSub13_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub
Private Sub oMnuTrackerSub14_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    Call myClick_Event(Ctrl)
End Sub

[RiceRocket]

' PART 2 OF 2
 
Private Sub Populate_CB_Array(menuHoldsARs As CommandBarPopup)
'Takes all AR Tracker DBs from the Registry and adds a command
'bar button for each DB.
'The "AR Tracker DB Count" registry contains the name of each DB
'There is also a registry entry for each DB listed in "AR Tracker DB Count"
'For each DB registry entry, there is a Paths and Description section
'that contains the path and description of each DB.
 
On Error GoTo No_bugs
 
    Dim CBbuttons(15) As Office.CommandBarButton
    Dim DB_names As Variant
    Dim CB_Array() As Office.CommandBarButton
    Dim i As Integer
    Dim DB_name_path_description() As String
    Dim myCtrl As Office.CommandBarButton
    
    'get DB Names from Registry
    DB_names = GetAllSettings("AR Tracker DB Count", "DB Count") 'ReDims automatically based on num of reg entries
    ReDim DB_name_path_description(1, 1, UBound(DB_names))
    ReDim CB_Array(UBound(DB_names))
    
    Set CBbuttons(0) = oMnuTrackerSub0
    Set CBbuttons(1) = oMnuTrackerSub1
    Set CBbuttons(2) = oMnuTrackerSub2
    Set CBbuttons(3) = oMnuTrackerSub3
    Set CBbuttons(4) = oMnuTrackerSub4
    Set CBbuttons(5) = oMnuTrackerSub5
    Set CBbuttons(6) = oMnuTrackerSub6
    Set CBbuttons(7) = oMnuTrackerSub7
    Set CBbuttons(8) = oMnuTrackerSub8
    Set CBbuttons(9) = oMnuTrackerSub9
    Set CBbuttons(10) = oMnuTrackerSub10
    Set CBbuttons(11) = oMnuTrackerSub11
    Set CBbuttons(12) = oMnuTrackerSub12
    Set CBbuttons(13) = oMnuTrackerSub13
    Set CBbuttons(14) = oMnuTrackerSub14
    
    For i = 0 To UBound(DB_names)
        'populate array with registry info
        '3D array has DB_Name as Page, 1 - 2D element per page (path = (0,0), description = (0,1))
        DB_name_path_description(0, 0, i) = GetSetting(DB_names(i, 0), "Paths", "DB Path")
        DB_name_path_description(0, 1, i) = GetSetting(DB_names(i, 0), "Description", "DB Description")
        
        'populate CommandBarButton Array
        Set CB_Array(i) = menuHoldsARs.Controls.Add(msoControlButton, 1, , , False)
        With CB_Array(i)
            .BeginGroup = False
            .Caption = DB_names(i, 0)
            .Enabled = True
            .Style = msoControlCustom
            .Tag = i & ", " & DB_name_path_description(0, 0, i) 'identify each button, Syntax: <button#, "DB Path">
            .TooltipText = DB_name_path_description(0, 1, i) 'DB description as ToolTipText
            .Visible = True
        End With
        'Set CBbuttons(i) = CB_Array(i) 'Set each button to have WithEvents
    Next i
    
    Set oMnuTrackerSub0 = CB_Array(0)
    Set oMnuTrackerSub1 = CB_Array(1)
    Set oMnuTrackerSub2 = CB_Array(2)
    Set oMnuTrackerSub3 = CB_Array(3)
    Set oMnuTrackerSub4 = CB_Array(4)
    Set oMnuTrackerSub5 = CB_Array(5)
    Set oMnuTrackerSub6 = CB_Array(6)
    Set oMnuTrackerSub7 = CB_Array(7)
    Set oMnuTrackerSub8 = CB_Array(8)
    Set oMnuTrackerSub9 = CB_Array(9)
    Set oMnuTrackerSub10 = CB_Array(10)
    Set oMnuTrackerSub11 = CB_Array(11)
    Set oMnuTrackerSub12 = CB_Array(12)
    Set oMnuTrackerSub13 = CB_Array(13)
    Set oMnuTrackerSub14 = CB_Array(14)
    
No_bugs:
If Err.Number = "9" Then
Else:   Menu_Text ("Error!")
        MsgBox "Outlook encountered an error" _
        & vbCr & "Error Number: " & Err.Number _
        & vbCr & "Error: " & Err.description
End If
End Sub
 
Public Sub myClick_Event(Ctrl As Office.CommandBarButton)
'Dim oApp        As Outlook.Application
Dim myExplorers As Outlook.Explorer
Dim myExpSel    As Outlook.Selection
Dim oEmail      As Outlook.MailItem
'Dim myStep As Label
 
Set myExplorers = Application.ActiveExplorer
Set myExpSel = myExplorers.Selection
Set oEmail = myExpSel.Item(1)
 
    quitting = False
 
    connectionString = Mid$(Ctrl.Tag, 4, Len(Ctrl.Tag))
    
    Pass_Connection_Path (connectionString)
 
    Call FindOutlookEmail(oEmail.EntryID, oEmail.Subject) 'Determine if its already in tracker, set recordneedstobedeleted flag
 
    If Not quitting Then
        Call arInfo.AR_Menu_Click   'Add current email (calls Outlook_Emails_2_Access)
    End If
    If Not quitting Then
        If recordNeedsDeleting Then Call DeleteRecord   'Delete selected records in SimilarARs form
    End If
    
    Menu_Text ("Ready")
    Unload arInfo
    Unload Calendar
    Unload DBadd
    Unload DBaddORedit
    Unload SimilarARs
    If Connection_Exists Then Close_Connection
    Set oEmail = Nothing
    Set myExplorers = Nothing
    Set myExpSel = Nothing
    'Restart_Prog
End Sub

[RobDog888]

First, place a breakpoint at maillogoncomplete and step through the code to make sure everything is being created correctly. Then place another at the myclick event and track the code execution. I dont think you should be setting the array from the commandbuttons and then back again. This may be an issue but the step through should show you whats up.